Манипуляции со строками в VBA

Question

У меня есть один столбец, который нужно разделить на несколько, как текст в столбцы в Excel. Однако есть небольшая проблема. Обычный разделитель не будет работать. Рассмотрим строку ниже

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

Канал в требуемой строке означает, что он должен быть разбит здесь и скопирован в следующий столбец в соответствии с длиной строки.

У меня есть список в столбце А с 506 строками. Я использовал следующую формулу, чтобы проверить вхождение «\» в столбце B, диапазон значений от 0 до 66

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

Мне нужна помощь, чтобы кодировать следующую логику

1. Найти "\" в строке
2. Найдите пробел прямо перед "\" и разделите

Я использовал следующий код, но он не служит цели

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

Пожалуйста, помогите с кодом, который учитывает пункты 1 и 2.

Answer 1

Это должно сделать это, хотя я использовал другую логику для вашего требования.

Вы хотели найти пробел \ перед, где мой код просто ищет Domain (обратите внимание на пробел).

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

До

После

Обратите внимание, что я немного обновил некоторые слова, чтобы показать, что они копируют правильные данные, но это также было проверено на вашем примере.

Перед тем, как протестировать его, убедитесь, что сначала создали резервную копию ваших данных, так как макрос не может быть отменен!

Answer 2

Sub ExtractBySlash()

Dim R As Range

Dim subS As Variant

Dim x As Long

Dim y As Long

Тусклый счетчик As Long

counter = 1

Для каждого диапазона r («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

Следующий г

End Sub