Adressbuch aus einer Spalte erstellen

[Pcfritz]

Hallo zusammen!

Ich habe den Wunsch, aus einem Adressbuch, in dem alle Informationen untereinander in einer Spalte stehen, in ein Format zu bringen, dass die Daten gliedert: Name, Geburtsort, Ehepartner, Adresse etc. 

Das Problem an der Sache ist jedoch, dass natürlich nicht von Allen die gleichen Daten vorliegen, manchmal fehlt die Email Adresse oder es wurde keine Faxnummer angegeben... Ein Merkmal ist aber überall gleich: In der Zeile unter dem Vor- und Nachnamen steht immer der Geburtsort, welcher mit "*" beginnt. 

Gibt es eine Möglichkeit, aus einer Spalte mehrere zu machen? Kann man Excel sagen, alle Informationen, die eine Zeile über der Zeile mit "*" stehen bis zwei Zeilen vor der nächsten Zeile mit "*" gehören zusammen und sollen in Spalten einsortiert werden?

Ich hoffe, ihr habt mein Anliegen verstanden und könnt mir weiterhelfen.

Vielen Danke im Voraus, 

Pcfritz

[Dieter63]

Hallo ,

haben die Daten ein Trennzeichen wie auch  immer ; ,  Leerzeichen

dann Spalte markieren -->    Daten --> Text in Spalten  --> Trennzeichen   auswählen dem Editor foglen

ansonsten müsstest du uns mal  wenigstens ein Beispiel liefern

[Pcfritz]

Nein, richtige Trennzeichen gibt es leider nicht, siehe Anhang.

[Dieter63]

Hallo,

ok

wo kommen die Daten her --> kannst du da was dran ändern oder dir neu als z.b. CSV erstellen lassen?

ansonsten sieht das nach manuelle Arbeit  aus.

[Kuwer]

Hallo,

per VBA z.B. so:

Sub KontakteInSpalten()
  Dim lngAnzahl As Long, lngSpalte As Long, lngZeile As Long
  Dim rngQ As Range
  Dim varQ As Variant, varZ As Variant
  
  Set rngQ = Cells(1).CurrentRegion.Columns(1)
  varQ = rngQ.Value
  lngAnzahl = Application.WorksheetFunction.CountIf(rngQ, "~**")
  ReDim varZ(1 To lngAnzahl, 1 To UBound(varQ) / lngAnzahl * 2)
  
  For lngAnzahl = 1 To UBound(varQ) - 1
    If Left(varQ(lngAnzahl + 1, 1), 1) = "*" Then
      lngZeile = lngZeile + 1
      lngSpalte = 0
    End If
    lngSpalte = lngSpalte + 1
    varZ(lngZeile, lngSpalte) = varQ(lngAnzahl, 1)
  Next lngAnzahl
  
  Cells(1, 3).Resize(UBound(varZ, 1), UBound(varZ, 2)).Value = varZ
End Sub

Gruß Uwe