
Ich habe eine einzelne Spalte, die in mehrere aufgeteilt werden muss, wie Text-in-Spalten in Excel. Allerdings gibt es eine kleine Herausforderung. Herkömmliche Trennzeichen funktionieren nicht. Betrachten Sie die folgende Zeichenfolge
Original: Domain\Domain Admins Domain2\User Group Domain3\Developers .....(And so on)
Required: Domain\Domain Admins | Domain2\User Group | Domain3\Developers .....(And so on)
Das Pipe-Zeichen in der erforderlichen Zeichenfolge bedeutet, dass sie hier geteilt und entsprechend der Länge der Zeichenfolge in die nächste Spalte kopiert werden muss.
Ich habe die Liste in Spalte A mit 506 Zeilen. Ich habe die folgende Formel verwendet, um das Vorkommen von "\" in Spalte B zu überprüfen, die Anzahl reicht von 0-66
=LEN(A2)-LEN(SUBSTITUTE(A2,"\",""))
Ich brauche Hilfe beim Coden der folgenden Logik
- Suchen Sie nach "\" in der Zeichenfolge
- Suchen Sie das Leerzeichen direkt vor dem "\" und teilen Sie
Ich habe folgenden Code verwendet, aber er erfüllt nicht seinen Zweck
Range("A1:A506").Select
Selection.TextToColumns
Bitte helfen Sie mit einem Code, der die Punkte 1 und 2 berücksichtigt.
Antwort1
Dies sollte funktionieren, obwohl ich für Ihre Anforderung eine andere Logik verwendet habe.
Sie wollten ein \ vor einem Leerzeichen finden, während mein Code einfach nach Domain
(beachten Sie das Leerzeichen) sucht.
Option Explicit
Sub DoThis()
Dim col As Integer
col = 65
Dim splitWord As String
splitWord = "Domain"
Dim row As Integer
row = 1
Do While (Range("A" & row).value <> "")
Dim value As String
value = Range("A" & row).value
Dim values() As String
values = Split(value, " " & splitWord)
Dim firstResult As String
Dim i As Integer
For i = 1 To UBound(values)
firstResult = values(0) ' not efficient but easier code to read
Range(Chr(col + i) & row).value = splitWord & values(i)
Next i
Range(Chr(col) & row).value = firstResult
row = row + 1
col = 65
Loop
End Sub
Vor
Nach
Bitte beachten Sie, dass ich einige Wörter leicht aktualisiert habe, um zu zeigen, dass die richtigen Daten kopiert werden. Es wurde jedoch auch mit Ihrem Beispiel getestet.
Erstellen Sie vor dem Testen unbedingt zuerst eine Sicherungskopie Ihrer Daten, da Makros wie dieses nicht rückgängig gemacht werden können!
Antwort2
Sub ExtractBySlash()
Dim r As Bereich
Dim subS als Variante
Dim x So lang
Dim y As Long
Dimmzähler So lange
Zähler = 1
Für jedes r im Bereich("a1:a506")
subS = Split(r.Text, "\")
For x = LBound(subS) + 1 To UBound(subS)
For y = Len(subS(x)) To 1 Step -1
If Mid(subS(x), y, 1) = " " Then
r.Offset(0, counter) = subS(x - 1) & "\" & Left(subS(x), y)
subS(x) = Trim(Right(subS(x), Len(subS(x)) - y))
counter = counter + 1
Exit For
End If
Next y
Next x
Nächstes r
End Sub