☰

Manipulación de cadenas en VBA

tag-icon • tag-icon microsoft-excel vba macros string-manipulation
Manipulación de cadenas en VBA

Tengo una sola columna que debe dividirse en varias, como Texto a columnas en Excel. Sin embargo, existe un pequeño desafío. El delimitador convencional no funcionará. Considere la siguiente cadena

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

La tubería en la cadena requerida significa que debe dividirse aquí y copiarse a la siguiente columna según la longitud de la cadena.

Tengo la lista en la columna A con 506 filas. Utilicé la siguiente fórmula para comprobar la aparición de "\" en la columna B, el recuento oscila entre 0 y 66

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

Necesito ayuda para codificar siguiendo la lógica.

  1. Busque "\" en la cadena
  2. Encuentra el espacio justo antes de "\" y divídelo

Utilicé el siguiente código pero no sirve para el propósito.

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

Ayúdenos con un código que tenga en cuenta los puntos 1 y 2.

Respuesta1

Esto debería ser suficiente, aunque he usado una lógica diferente a la suya.

Querías encontrar un \ antes del espacio en blanco, mientras que mi código simplemente busca Domain(nota el espacio en blanco).

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

ingrese la descripción de la imagen aquí

Después

ingrese la descripción de la imagen aquí

Tenga en cuenta que actualicé ligeramente algunas de las palabras para mostrar que está copiando los datos correctos, pero también se probó con su ejemplo.

Antes de probarlo, asegúrese de crear primero una copia de seguridad de sus datos, ya que macros como esta no se pueden deshacer.

Respuesta2

SubExtractBySlash()

Atenuar r como rango

Atenuar subS como variante

Oscuro x Mientras Largo

Dim y mientras

Contador oscuro siempre y cuando

contador = 1

Para cada r en el rango("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

siguiente r

Subtítulo final

información relacionada