☰

Обработка строк в VBA

tag-icon • tag-icon microsoft-excel vba macros string-manipulation
Обработка строк в VBA

У меня есть один столбец, который нужно разделить на несколько, как Text-to-columns в 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)

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

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

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

Мне нужна помощь в кодировании следующей логики

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

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

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

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

решение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

До

введите описание изображения здесь

После

введите описание изображения здесь

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

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

решение2

Подпрограмма ExtractBySlash()

Dim r как диапазон

Dim subS как вариант

Dim x As Long

Тусклый и как длинный

Счетчик Dim As Long

счетчик = 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

Следующий р

Конец субтитра

Связанный контент