Manipulacja stringami w VBA


2

Mam pojedynczą kolumnę, która musi zostać podzielona na wiele, np. Tekst na kolumny w programie Excel. Jest jednak małe wyzwanie. Konwencjonalny ogranicznik nie będzie działać. Rozważ poniższy ciąg

Original: Domain\Domain Admins Domain2\User Group Domain3\Developers .....(And so on)
Required: Domain\Domain Admins | Domain2\User Group | Domain3\Developers .....(And so on)

Rura w wymaganym ciągu oznacza, że ​​należy ją tutaj podzielić i skopiować do następnej kolumny zgodnie z długością łańcucha.

Mam listę w kolumnie A z 506 wierszami. Użyłem następującej formuły, aby sprawdzić występowanie „i” w kolumnie B, zakresy od 0 do 66

=LEN(A2)-LEN(SUBSTITUTE(A2,"\",""))

Potrzebuję pomocy w kodowaniu następującej logiki

  1. Znajdź „” w ciągu
  2. Znajdź przestrzeń tuż przed „i”

Użyłem następującego kodu, ale nie służy to celowi

Range("A1:A506").Select
Selection.TextToColumns 

Pomóż z kodem, który ma na uwadze punkty 1 i 2.

Odpowiedzi:


1

Powinno to zrobić, chociaż użyłem innej logiki do twojego wymagania.

Chciałeś znaleźć białą przestrzeń, której mój kod po prostu szuka Domain (zwróć uwagę na białą przestrzeń).

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

Przed

enter image description here

Po

enter image description here

Pamiętaj, że trochę zaktualizowałem niektóre słowa, aby pokazać, że kopiuje prawidłowe dane, ale zostało to również przetestowane z twoim przykładem.

Zanim go przetestujesz, upewnij się, że twoja kopia zapasowa danych jest najpierw taka, jak makro, nie można tego cofnąć!


0

Sub ExtractBySlash ()

Dim r As Range

Przyciemnij podsystem jako wariant

Dim x As Long

Dim As As Long

Dim counter As Long

counter = 1

Dla każdego rw zakresie („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

Dalej r

Napis końcowy

Korzystając z naszej strony potwierdzasz, że przeczytałeś(-aś) i rozumiesz nasze zasady używania plików cookie i zasady ochrony prywatności.
Licensed under cc by-sa 3.0 with attribution required.