Zelleninhalt auf verschiedene Zellen verteilen

Dieses Thema Zelleninhalt auf verschiedene Zellen verteilen im Forum "Microsoft Office Suite" wurde erstellt von klexy, 23. Okt. 2002.

Thema: Zelleninhalt auf verschiedene Zellen verteilen Ich habe folgende Daten in Excel 97 (Leerzeichen werden durch * dargestellt):...

  1. Ich habe folgende Daten in Excel 97 (Leerzeichen werden durch * dargestellt):

    12***********Mayer*/*Opernplatz*12*/*D-12345*Musterstadt
    54144512*****Schumacher*/*Ferraristr.*12*/*D-70327*Stuttgart
    123456*******Dorfdepp*/*An*den*Weihern*12*A*/*D-70327*Stuttgart
    654321*******von*Kartoffelsberg*/*Alte*Parkstr.*12*-*14*/*D-78333*Schlonzheim-Mürpfingen
    (Kundennummer, Name, Straße, Hausnummer, PLZ, Ort) - Namen und Adressen sind vielfältig in ihrer Länge und Struktur.

    Feste Elemente sind:
    - 13 Stellen bis der Name anfängt (egal wie lang die Kundennummer ist)
    - Schrägstriche nach Name und vor PLZ.

    Die Kundennummer separiere ich mit =GLÄTTEN(LINKS(A1;13)).
    Aber wie trenne ich die anderen Elemente voneinander - unabhängig von ihrer Struktur?

    Keine Ahnung wonach ich in der Excel-97-Hilfe suchen muß. Welche Funktionen sind das?

    Zefix nochamol!  :mad:
     
  2. Hallo klexy,

    unter Daten->Text in Spalten...

    Dort kannst Du Texte, die aus mehreren Begriffen bestehen und durch ein festes Trennzeichen (bei dir / , eintragen unter 'andere') getrennt sind, in mehrere Spalten auftrennen. Eine Vorschau der Aufteilung ist auch vorhanden.

    Das passt bei diesem Problem, da du die Kundennummer bereits abgetrennt hast.

    Gruß Matjes :)

    Brötchen ? ;)
     
  3. Höchstens halbes Brötchen. ;)

    Die Kundennummer kann ich aus dieser Zelle zwar in eine andere Zelle schreiben, in der Ursprungszelle ist sie aber immer noch vorhanden und wird nach deiner Methode mit in die erste Zelle mit übernommen.
    =LINKS(A1;13) heißt ja zeig mir die ersten 13 Zeichen von links. Gibt es auch zeig mir alle *außer* den ersten 13 Zeichen von Links?
    Ha! ;D Hab ich grad selber gefunden: =TEIL(A1;14;100) heißt zeig mir die nächsten 100 ab Stelle 14.

    Gibt es da nicht eine Funktion für: gehe bis zum ersten / und schreib das in Zelle xy, dann bis zum nächsten / und schreib das in Zelle yz usw. ? Ich meine, sowas schon gesehen zu haben, aber wo? ???
    Sonst müsste ich da mit Makro laborieren und das kann ich nicht vernünftig.
     
  4. Hi Klexy,

    hier ein Makro zum ausprobieren.
    Wenn es noch Schwiergkeiten gibt, melde dich.

    Gruß Matjes :)

    ganzes Brötchen ? ;)



    Code:
     
    Option Explicit
    
    Sub StrAdresseInZellenAufteilen()
    'Erwartet wird ein String pro Zelle der Form
    '12***********Mayer*/*Opernplatz*12*/*D-12345*Musterstadt
    '1-13: Kundennummer, Name, Straße, Hausnummer, PLZ, Ort, * bedeutet Leerzeichen
    'Die Selektion enthält nur Zellen dieses Formats
    '
    
    Dim strKNr As String
    Const cKNrLng = 13
    Dim strName As String
    Dim strStrasseHNr As String
    Dim strStrasse As String
    Dim strHNr As String
    Dim strPLZ As String
    Dim strOrt As String
    Dim tmpStr As String
    Dim C As Range
    Dim pos1 As Integer, x As Integer
    Const cMinStrLng = 40 'Mindestlänge eines Strings
    Const cTrenner = / 'Trennzeichen
    Const cMld_Trenner = Adressstring hat nicht das richtige Format _
           & vbCrLf &  / fehlt
    
    For Each C In Selection
     tmpStr = C.Value
     If Len(tmpStr) >= cMinStrLng Then 'Mindestlänge des Strings
    
      'Kennummer
      strKNr = Left(tmpStr, cKNrLng)
      tmpStr = Right(tmpStr, Len(tmpStr) - cKNrLng)
    
      'Name
      pos1 = InStr(1, tmpStr, cTrenner) ' / suchen
      If pos1 > 0 Then
       strName = Left(tmpStr, pos1 - 2)
       tmpStr = Right(tmpStr, Len(tmpStr) - pos1 - 1)
    
       'Strasse/Hausnummer
       pos1 = InStr(1, tmpStr, cTrenner) ' / suchen
       If pos1 > 0 Then
        strStrasseHNr = Left(tmpStr, pos1 - 2)
        tmpStr = Right(tmpStr, Len(tmpStr) - pos1 - 1)
    
        'Strasse/Hausnummer trennen
        x = 1
        Do
         If IsNumeric(Mid(strStrasseHNr, x, 1)) Then Exit Do
         x = x + 1
        Loop Until x > Len(strStrasseHNr)
        If x <= Len(strStrasseHNr) Then
         strStrasse = Left(strStrasseHNr, x - 2)
         strHNr = Right(strStrasseHNr, Len(strStrasseHNr) - x + 1)
        Else
         strStrasse = strStrasseHNr
         strHNr =         'keine Hausnummer
        End If
        
        'PLZ und Ort
        pos1 = InStr(1, tmpStr,  ) ' blanc suchen
        If pos1 > 0 Then
         strOrt = Right(tmpStr, Len(tmpStr) - pos1)
         strPLZ = Left(tmpStr, pos1 - 1)
         
         'Werte in Zellen schreiben
         ActiveSheet.Cells(C.Row, C.Column).Value = strKNr
         ActiveSheet.Cells(C.Row, C.Column + 1).Value = strName
         ActiveSheet.Cells(C.Row, C.Column + 2).Value = strStrasse
         ActiveSheet.Cells(C.Row, C.Column + 3).Value = strHNr
         ActiveSheet.Cells(C.Row, C.Column + 4).Value = strPLZ
         ActiveSheet.Cells(C.Row, C.Column + 5).Value = strOrt
    
         'Zellen formatieren
         ActiveSheet.Cells(C.Row, C.Column).NumberFormat = 000000000000
         For x = 1 To 5
          With ActiveSheet.Cells(C.Row, C.Column + x)
            .NumberFormat = @
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .IndentLevel = 0
            .ShrinkToFit = False
            .MergeCells = False
          End With
         Next
         
        Else
         C.Interior.ColorIndex = 3 'rot
         MsgBox (cMld_Trenner)
        End If
       Else
        C.Interior.ColorIndex = 3 'rot
        MsgBox (cMld_Trenner)
       End If
      Else
       C.Interior.ColorIndex = 3 'rot
       MsgBox (cMld_Trenner)
      End If
     End If
    Next
    
    End Sub
    
    
     
  5. Dreiviertel Brötchen. ;)

    Makro funktioniert an und pfirsich. Aber nicht 100%ig wenn ich den Blattschutz auf die Tabelle gelegt habe. Der ist aber nötig weil die Tabelle ein Formular darstellt in dem DAUs rumwerkeln.
    Das Ergebnis wird dann zwar korrekt ausgegeben aber es kommt trotzdem folgende Fehlermeldung, die ich den Leuten nicht zumuten kann:

    Laufzeitfehler '1004'
    Die Number-Format-Eigenschaft des Range-Objekts kann nicht festgelegt werden.

    Bei Testen markiert er mir folgendes gelb:
    [...]
    ActiveSheet.Cells(C.Row, C.Column).NumberFormat = 000000000000
    [...]
    Liegt wahrscheinlich daran, daß der Menüpunkt Format bei gesperrtem Tabellenblatt nicht verfügbar ist. Aus diesem Grund jedenfalls funktioniert auch ein Makro über den Menüpunkt Daten>Text in Spalten nicht.

    Ich habe aber zwischenzeitlich ein wenig herumgehirnt und bin auf folgende elegante Lösung gekommen, die ohne Makro auskommt:

    654321 von Kartoffelsberg / Alte Parkstr. 12 - 14 / D-78333 Schlonzheim-Mürpfingen
    654321*******von*Kartoffelsberg*/*Alte*Parkstr.*12*-*14*/*D-78333*Schlonzheim-Mürpfingen (Leerzeichen hier durch * dargestellt):

    Kundennummer: =GLÄTTEN(LINKS(A1;13))
    Name: =GLÄTTEN(TEIL(LINKS(A1;FINDEN(/;A1)-1);14;100))
    Adresse: =GLÄTTEN(TEIL(A1; FINDEN(/; A1)+1; (FINDEN(/;A1;FINDEN(/;A1)+1))-(FINDEN(/;A1))-1))
    PLZ: =GLÄTTEN(TEIL(RECHTS(A1;LÄNGE(A1)-(FINDEN(/;A1;FINDEN(/;A1)+1))-1);3;5))
    Ort: =GLÄTTEN(TEIL(RECHTS(A1;LÄNGE(A1)-(FINDEN(/;A1;FINDEN(/; A1)+1))-1);8;100))

    Am Ende dieses Formulars hab ich jetzt einen Makro-Button, der den ganzen Schlonz in eine Tabelle in das nächste Tabellenblatt exportieren soll. Und zwar in die erste freie Zeile. Wo ich nicht weiterkomm: Wie bring ich dem Makro bei, die erste freie Zeile zu suchen (Tasten <Strg+Ende>, <Pos 1>, <eins runter>). Hat irgendwas mit xlFirst zu tun, aber hier ist für mich Endstation der Syntax.
    ???
     
  6. Hi Klexy,

    hab den Makro umgeschrieben:

    Ergebnisse landen auf dem Folgeblatt (hoffentlich kein Blattschutz :>>) in der ersten freien Zeile, so wie Du es wolltest.

    Kundennummer als Zahl mit führenden Nullen
    Name als Text
    Adresse als Text
    PLZ als Text
    Ort als Text

    !Achtung: erste freie Zeile heißt erste nicht benutzte Zeile !
    Excel hat eine Macke: Wenn man etwas in eine Zelle schreibt und wieder löscht ist diese Zelle nicht mehr unbenutzt, obwohl nichts mehr darin steht. Das Erscheinungsbild sind dann mehrere leere Zeilen vor dem Eintrag des Makros.
    Behebung: Leere Zeilen löschen



    Viel Spaß beim Ausprobieren

    Matjes :>>>

    Brötchen, Brötchen, Brötchen .... ('o' )

    ps: erweiterbar ist der Makro, z.B. vor dem Eintrag auf doppelte Kundennummern prüfen, auf gleiche Namen,Adressen usw.

    Makro ist per mail unterwegs

    Code:
    Option Explicit
    
    Sub StrAdresseInZellenAufteilen()
    'Erwartet wird ein String pro Zelle der Form
    '12***********Mayer*/*Opernplatz*12*/*D-12345*Musterstadt
    '1-13: Kundennummer, Name, Adresse, PLZ, Ort, * bedeutet Leerzeichen
    'Die Selektion enthält nur Zellen dieses Formats
    '
    'Kundennummer, Name, Adresse, PLZ, Ort werden aus dem String selektiert
    'selektierte Werte werden in erste freie Zeile auf dem folgenden Blatt geschreiben
    
    
    Dim strKNr As String, strName As String, strAdresse As String, strPLZ As String, strOrt As String
    Const cKNrLng = 13
    Dim tmpStr As String
    Dim C As Range 'selektierte Zellen
    Dim pos1 As Integer, x As Integer, next_row As Integer
    Const cMinStrLng = 40 'Mindestlänge eines Strings
    Const cTrenner = / 'Trennzeichen
    
     For Each C In Selection 'über alle selektierten Zellen
      tmpStr = C.Value
      If Len(tmpStr) >= cMinStrLng Then 'Mindestlänge des Strings
       'Kennummer
       strKNr = Left(tmpStr, cKNrLng) ' Kennummer selektieren
       tmpStr = Right(tmpStr, Len(tmpStr) - cKNrLng) 'Kennummer abschneiden
       'Name
       pos1 = InStr(1, tmpStr, cTrenner) ' Trenner / nach Name suchen
       If pos1 > 0 Then
        strName = Left(tmpStr, pos1 - 2) 'Name selektieren
        tmpStr = Right(tmpStr, Len(tmpStr) - pos1 - 1) ' Namen + ' / ' abschneiden
        'Adresse
        pos1 = InStr(1, tmpStr, cTrenner) 'Trenner / nach Adresse suchen
        If pos1 > 0 Then
         strAdresse = Left(tmpStr, pos1 - 2) 'Adresse selektieren
         tmpStr = Right(tmpStr, Len(tmpStr) - pos1 - 1) ' Adresse + ' / ' abschneiden
         
         'PLZ und Ort (ist der Rest)
         pos1 = InStr(1, tmpStr,  ) ' Leerzeichen nach PLZ suchen
         If pos1 > 0 Then
          strOrt = Right(tmpStr, Len(tmpStr) - pos1) 'Ort selektieren
          strPLZ = Left(tmpStr, pos1 - 1)      'PLZ selektieren
          
          'Werte in erste freie Zeile auf dem folgenden Blatt schreiben
          With Worksheets(ActiveSheet.Index + 1)
           next_row = .Cells.SpecialCells(xlCellTypeLastCell).Row + 1
           .Cells(next_row, 1).Value = strKNr
           .Cells(next_row, 2).Value = strName
           .Cells(next_row, 3).Value = strAdresse
           .Cells(next_row, 4).Value = strPLZ
           .Cells(next_row, 5).Value = strOrt
          End With
     
          'Zellen formatieren
          For x = 1 To 5
           With Worksheets(ActiveSheet.Index + 1).Cells(next_row, x)
             .NumberFormat = @      'Format Text
             .HorizontalAlignment = xlLeft 'horizontale Ausrichtung
             .VerticalAlignment = xlTop  'vertikale Ausrichtung
             .WrapText = True       'Zeilenumbruch
           End With
          Next
          'Kundennummer: Format Zahl mit führenden Nullen, ohne Komma
          Worksheets(ActiveSheet.Index + 1).Cells(next_row, 1).NumberFormat = 000000000000
          
         Else
          MsgBox (Adressstring hat nicht das richtige Format & vbCrLf & _
               ' ' fehlt & vbCrLf & vbCrLf & _
              PLZ Ort & vbCrLf & _
              Zeile:  & C.Row)
         End If
        Else
         MsgBox (Adressstring hat nicht das richtige Format & vbCrLf & _
              / fehlt & vbCrLf & vbCrLf & _
             nach Adresse & vbCrLf & _
             Zeile:  & C.Row)
        End If
       Else
        MsgBox (Adressstring hat nicht das richtige Format & vbCrLf & _
             / fehlt & vbCrLf & vbCrLf & _
            nach Name & vbCrLf & _
            Zeile:  & C.Row)
       End If
      End If
     Next
     
    End Sub
    
    
    
     
  7. Das sieht aber schwer nach Brot aus. ;D

    Das grün geschriebene ist nicht Teil des Makros sondern nur Erklärungstext, stimmt's?
    Durch den Rest werd ich mich am Wochenende durchbeißen. Vielleicht versteh ich es ja.

    Ziel ist, die Separation per Formel zu machen und den Teil deines Makros, der die Daten ins nächste Tabellenblatt überträgt, in ein eigenes Makro zu implementieren, welches das erste Blatt druckt, überträgt, und löscht. Der nächste Kunde kommt dann wieder an die gleiche Stelle des ersten Blattes, wird gedruckt, übertragen und gelöscht.

    ...meilenweit bevor ich schlafen kann (wie der Dichter sagt).
     
Die Seite wird geladen...

Zelleninhalt auf verschiedene Zellen verteilen - Ähnliche Themen

Forum Datum
Zelleninhalte automatisch verschieben Microsoft Office Suite 27. Feb. 2013
Zelleninhalt gleich Zelleninhalt Windows XP Forum 30. Jan. 2007
Anzahl Zelleninhalt Microsoft Office Suite 21. Dez. 2006
Zelleninhalt überprüfen und kopieren Windows XP Forum 11. Aug. 2006
Zelleninhalt in jeweilige Zelle Kopieren Microsoft Office Suite 8. Nov. 2005