String Manupulation no VBA

Question

Eu tenho uma coluna única que precisa ser dividida em várias, como Text-to-columns no Excel. No entanto, há um pequeno desafio. O delimitador convencional não funcionará. Considere a sequência abaixo

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

O canal na string necessária significa que ele precisa ser dividido aqui e copiado para a próxima coluna de acordo com o comprimento da string.

Eu tenho a lista na coluna A com 506 linhas. Eu usei a seguinte fórmula para verificar a ocorrência de "\" i coluna B, contar intervalos de 0-66

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

Preciso de ajuda para codificar a seguinte lógica

1. Encontre "\" na string
2. Encontre o espaço antes do "\" e divida

Eu usei o seguinte código, mas ele não serve ao propósito

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

Por favor, ajude com um código que mantenha os pontos 1 e 2 em mente.

    

Answer 1

Isso deve ser feito, embora eu tenha usado uma lógica diferente para sua exigência.

Você queria encontrar um \ before white space, onde o meu código simplesmente procura por Domain (observe o espaço em branco).

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

Antes

Depois

Por favor, note que atualizei algumas das palavras para mostrar que está copiando os dados corretos, mas também foi testado com o seu exemplo.

Antes de testá-lo, certifique-se de criar um backup dos dados primeiro, pois as macros desse tipo não podem ser desfeitas!

    

Answer 2

Sub ExtractBySlash ()

Dim r Como intervalo

Dim subS As Variant

Dim x As Long

Dim y como longo

Contador de Dimensões As Long

contador = 1

Para cada r Intervalo ("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

Próximo r

End Sub