Supportnet / Forum / Tabellenkalkulation

Hallo zusammen gerne möchte ich eine ganze liste von namen\vornamen\ort (welches alles so in einer zelle steht) auf einzelne zellen aufteilen. da es aber nicht bei allen einen vornamen hat, sollte bei diesen die zelle dann einfach leer sein und nicht aufrücken Bsp. (steht in a1..a2..a3 etc..) müller\daniel\zürich urg\philip\baden volenweider\unterägeri sollte liefern: b1 müller b2 urg b3 vollenweider c1 daniel c2 philip c3 <leer> d1 zürich d2 baden d3 unterägeri besten dank für eure hilfe raphi ps. excel 2003

Hallo,

geht von Grundsatz her so

in B1 -> =TEIL($A1;1;FINDEN("\";$A1;1)-1)

in C1 -> =TEIL($A1;FINDEN("\";$A1;1)+1;FINDEN("\";$A1;FINDEN("\";$A1;1)+1)-FINDEN("\";$A1;1)-1)

in D1 -> =TEIL($A1;FINDEN("\";$A1;FINDEN("\";$A1;FINDEN("\";$A1;1)+1))+1;50)

Wobei es mit den Fehlenden Daten Probleme gibt, da dies so nicht ohne Weiteres von der Formel festgestellt wird, wie bei


Hie kommt eine Fehlermeldung

volenweider\\unterägeri

gibt es keine Probleme

Gruß

Helmut

Mahlzeit!

Da ich sehr wenig ahnung von excel habe, würde ich keine formel nehmen, sondern das ganze über TEXT IN SPALTEN erledigen. dauert keine 10 sec.
und dann die entstandenen einzelnen zellen nach rechts ziehen soweit es notwendig ist.

wenn die Tabelle nur 100 adressen hat, sollte das in wenigen min. erledigt sein.

FRAGE: woher hast du diese quelldatei mit der komischen inhalt mit den \ als ternnzeichen? hast du da event. eine Exportfunktion nicht optimal abarbeiten lassen?

kromgi

Hallo,

wenn die Daten importiert werden müsste es ohne witere probleme gehen, da hierzu von @ cainam keine Angaben gemacht wurden, bin ich von einer normalen Exceldatei ausgegangen

Gruß

Helmut

es handelt sich eigentlich um filenamen die ich via eines makros ins excel geholt habe.. nur sind die jetzt so formatiert:

Y:\test\33213231-6544.xls
Y:\test\65465465-6546.xls
Y:\test\pascal müller\65468899-651.xls
Y:\test\pascal müller\69977654-5555.xls
y:\fasdfasdas\asdfasd\asdfsd\asas\sdfsd\sdasg.xls

Hallo raphi,
letztens hatte ich das hier schon mal mit Zeilenumbruch, hier nun noch mal für dich mit \.

Sub Makro1()
For i = 1 To Range("A65536").End(xlUp).Row
  Cells(i, 1).Select
  Call CRTextAufteilen(ActiveCell, "\")
Next i
End Sub


Sub CRTextAufteilen(c As Range, Trennung As String)
'
' CRTextAufteilen Makro
' Trennung z.B. "\" oder auch Chr(10)

Dim VarText, TextBisCR As String

VarText = c  
Beg = 1
Do
  PosCR = InStr(Beg, VarText, Trennung, 1)
  If (PosCR > 0) Then
      TextBisCR = Mid(VarText, Beg, PosCR - Beg)
      Beg = PosCR + 1
    Else
      If (Beg > 0) Then
        TextBisCR = Mid(VarText, Beg, Len(VarText) - Beg + 1)
        Beg = 0
      End If
  End If
  ActiveCell.Next.Select
  ActiveCell = TextBisCR
Loop While Beg > 0

End Sub

Alles was in Spalte A steht, wird bearbeitet. Hinterher stehen die textteile rechts daneben wie oben beschrieben.

Gruß
lorf

danke für das tool...

leider ist es noch nicht ganz das was ich brauche:

da wo kein (zb name) steht sollte die zelle leer bleiben, so dass am schluss alle nummern hinten unter einer spalte stehen....

Hallo cainam,
ich habe das jetzt nochmal so umbestaltet, dass jetzt alles "rechtsbündig" verschoben wird.

Sub Makro1()

Dim c As Range
Dim maxSp, Sp1, Zeilen As Integer
maxSp = 0
Zeilen = Range("A65536").End(xlUp).Row
For i = 1 To Zeilen
  Cells(i, 1).Select
  maxSp = Application.WorksheetFunction.Max(CRTextAufteilenR(ActiveCell, "\"), maxSp)
Next i
For i = 1 To Zeilen
  For Sp = maxSp + 3 To 2 Step -1
    Set c = Cells.Find(What:="*", After:=Cells(i, Sp), SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues)
    If (c.Column < 2) Then Exit For
    c.Cut
    ActiveSheet.Paste Destination:=Cells(i, Sp + 3)
  Next Sp
Next i

End Sub


Function CRTextAufteilenR(c As Range, Trennung As String)
'
' CRTextAufteilen Makro
' Trennung z.B. "\" oder auch Chr(10)

Dim VarText, TextBisCR, Sp As String
VarText = c
Beg = 1
Sp = 0
Do
  PosCR = InStr(Beg, VarText, Trennung, 1)
  If (PosCR > 0) Then
      TextBisCR = Mid(VarText, Beg, PosCR - Beg)
      Beg = PosCR + 1
      Sp = Sp + 1
    Else
      If (Beg > 0) Then
        TextBisCR = Mid(VarText, Beg, Len(VarText) - Beg + 1)
        Beg = 0
        Sp = Sp + 1
      End If
  End If
  ActiveCell.Next.Select
  ActiveCell = TextBisCR
Loop While Beg > 0

CRTextAufteilenR = Sp
End Function

Ich hoffe, das läuft so.

Gruß
lorf

• Einzelne Zellen in Excel sperren
• in excel zellen verbinden, ohne inhalte zu löschen
• Zellen nach gleichem Text überprüfen
• Gliederung in Excel auf 2 Zellen aufteilen