Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

String zerlegen





Frage

hallo, ich habe ein excel sheet, wobi in einer Celle bis zu 16 verschiede Namen drin stehen, die durch ein Komma von einander getrennt sind. Ich moechte mir gern ein Macro schreiben, was jeden Namen in eine extra Celle schreibt. d.h. Cell1: Martin, Stefan, Andreas, Tobi, Tom das ergebniss sollte dann so aussehn cell1:Martin cell2:Stefan cell3:Andreas cell4:Tobi cell5:Tom vielen dank

Antwort 1 von TeX

Das geht auch einfacher, klicke in der Menüleiste aud [Daten]->[Text in spalten] nachdem Du die Zelle markiert hast und dann kannst Du dort als Trennzeichen das Komma angeben.

Dann hast Du zwar die Namen in den Zellen A1, B1, C1 u.s.w., aber danach kannst Du die Daten markieren, kopieren und mit der Rechten Maustaste dann im Kontextmenü den Punkt "Inhalte einfügen" wählen. In dem sich öffnendem Dialogfeld einfach transponieren wählen und schon sind die Namen in einer Spalte, statt in einer Zeile.

Gruß TeX

Antwort 2 von Mike20192

danke fuer den tipp.

wuerde es trotzdem gern ueber ein makro loesen wollen, da es nur ein teil von einem noch groesserem makro werden soll. ist nur ein zwischenschritt, den ich auch gerne automatisiert haette.

Antwort 3 von TeX

Okay, dann schau ich mal morgen ob ich das hinbekomme.

Gruß TeX

P.S. Vielleicht opfert sich Helmut auf und schreibt es, bevor ich morgen wieder bisschen üben tue in VBA :-)

Antwort 4 von CaroS

Hi Mike20192,

die großen Meister des Fachs haben sich zurückgezogen, beim "Nachwuchs" dauert es ein bisschen länger, bis was kommt. Aber hier ist sie nun, die Variante 1:

Sub Aufteilen1()
Dim alle As String
Dim einzeln() As String
Dim i As Integer
Dim j As Integer
Dim z As Long

ActiveWorkbook.ActiveSheet.Select
Range("B8").Select
z = ActiveCell.Row
alle = ActiveCell.Value
Do While (Right(alle, 1) = ",")
  alle = Left(alle, Len(alle) - 1)
Loop
alle = alle & ","
i = 0
Do While (alle <> "")
  j = InStr(1, alle, ",", vbTextCompare)
  If j = 1 Then alle = Mid(alle, 2)
  If j > 1 Then
    ReDim Preserve einzeln(i)
    einzeln(i) = Left(alle, j - 1)
    alle = Mid(alle, j + 1)
    i = i + 1
  End If
Loop
For j = 0 To i - 1
  Cells(z + j, ActiveCell.Column) = einzeln(j)
Next

End Sub


Ich bin mir sicher, das man das noch etwas kompakter schreiben kann, aber erstmal wollte ich es zum Laufen kriegen (und dabei selber noch durchsehen). Mal sehen, was noch geht.

Bis dann!
CaroS

Antwort 5 von CaroS

Hi Mike20192, Du hast sicher bemerkt, dass es bei mir in Zelle B8 losgeht ( - war gerade die erste freie Zelle bei mir) - musst Du noch anpassen: Range("B8").Select
CaroS

Antwort 6 von CaroS

Hallo Mike20192,

hier etwas besser und etwas kürzer die 2. Variante. Plus 5 Kommentare. Startzelle wie oben: B8, überflüssige Kommas und Leerzeichen werden beseitigt. Getestet mit
B8 = ",,Tom,,Ina, Alf , Biene Maja ,,,Hans Peter, Susi,,,"

Sub Aufteilen2()
Dim alle As String
Dim i As Integer
Dim j As Integer
Dim z As Long

ActiveWorkbook.ActiveSheet.Select
Range("B8").Select
z = ActiveCell.Row
alle = ActiveCell.Value
Rem Kommas am Ende entfernen
Do While (Right(alle, 1) = ",")
  alle = Left(alle, Len(alle) - 1)
Loop
Rem Ein Komma am Ende anhängen
alle = alle & ","
i = 0
Do While (alle <> "")
  Rem Nächstes Komma suchen
  j = InStr(1, alle, ",", vbTextCompare)
  Rem Wenn links, dann entfernen
  If j = 1 Then alle = Mid(alle, 2)
  Rem Sonst Namen abtrennen, in nächste Zelle schreiben
  If j > 1 Then
    Cells(z + i, ActiveCell.Column) = Trim(Left(alle, j - 1))
    alle = Mid(alle, j + 1)
    i = i + 1
  End If
Loop

End Sub


Gruß,
CaroS

Antwort 7 von Mike20192

hi,
caroS,
einfach a draum... *JUPPI*

vielen dank fuer deine muehen, das prog erspart mir sehr viel arbeit
tausend dank

gruss

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: