Manipulação de Strings em VBA

Question

Eu tenho uma coluna única que precisa ser dividida em várias, como texto para colunas no Excel. No entanto, há um pequeno desafio. O delimitador convencional não funcionará. Considere a string 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 pipe 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.

Tenho a lista na coluna A com 506 linhas. Usei a seguinte fórmula para verificar a ocorrência de "\" na coluna B, a contagem varia de 0 a 66

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

Preciso de ajuda para codificar seguindo a lógica

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

Usei o código a seguir, mas ele não serve ao propósito

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

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

Answer 1

Isso deve bastar, embora eu tenha usado uma lógica diferente de sua necessidade.

Você queria encontrar um \ antes do espaço em branco, onde meu código simplesmente procura 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

Observe que atualizei ligeiramente algumas 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 seus dados primeiro, pois macros como essa não podem ser desfeitas!

Answer 2

Sub ExtrairBySlash()

Dim r como intervalo

Dim subS como variante

Dim x tão longo

Dim e enquanto

Dim contador enquanto

contador = 1

Para cada r no 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óxima

Finalizar sub