String-Manipulation in VBA

String-Manipulation in VBA

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

  1. Suchen Sie nach "\" in der Zeichenfolge
  2. 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

Bildbeschreibung hier eingeben

Nach

Bildbeschreibung hier eingeben

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

verwandte Informationen