¿Macro para bajar datos que están separados por un "|"?
Tengo en mi column "AT" y "AU" datos; En mi columna "AU" tengo datos que están separados por un "|", así :
Lo que me gustaría que hiciera la macro es que los que están en la columna "AU" me los separe y me los pongo por debajo de forma de listado, pero que asu ves en la columna "AT" me ponga ese dato las veces que separa la columna "AU" de mandera que me quede así :
Se repitió tres veces el "LATAM-MÉXICO-RMT-144557-30" por que en la columna "AU" tenia tres datos que los separaba un "|", ¿me pudieran pasar el vba que me haga eso de esas dos columnas?
Este es el resultado de la macro
y esta es la macro
Option Base 1
Sub separar_palabras()
Set datos = Range("at1").CurrentRegion
With datos
f = .Rows.Count: c = .Columns.Count
ReDim matriz(f * 5, 2)
Set datos = .Rows(2).Resize(f - 1, c)
x = 1
For i = 1 To f
texto = .Cells(i, 2)
separa = Split(texto, "|")
For j = 0 To UBound(separa)
matriz(x, 1) = .Cells(i, 1)
matriz(x, 2) = Trim(separa(j))
x = x + 1
Next j
Next i
.Clear
Set datos = .Resize(f * 5, 2)
Range(.Address) = matriz
.EntireColumn.AutoFit
End With
Erase matriz
Set datos = Nothing
End Sub
1 respuesta más de otro experto
[Hola
Te paso la macro
Sub SEPARA_CADENA()
'
'VALORA LA RESPUESTA PARA FINALIZAR
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
ini = 2 'fila inicio
k = 1
h2.Cells.ClearContents
For i = ini To h1.Range("AT" & Rows.Count).End(xlUp).Row
If InStr(1, h1.Cells(i, "AU"), "|") > 0 Then
cad = Split(h1.Cells(i, "AU"), "|")
For J = LBound(cad) To UBound(cad)
h2.Cells(k, "A") = h1.Cells(i, "AT")
h2.Cells(k, "B") = cad(J)
k = k + 1
Next J
End If
Next i
'
MsgBox "Fin"
End Sub
Hola muchas gracias si es lo que necesito solo tengo una pregunta :
Tengo varias celdas que no tiene un "|" solo viene una selección por ejemplo así
A1) Compromiso Social
A2) Compromiso Social
A3) Compromiso Social
A4) Compromiso Social
A5) Compromiso Social
Para esos casos me los elimina y empieza a contar desde donde encuentra un "|", y también en esos casos tnecesito que los deje como están.
Te paso la macro actualizada
Sub SEPARA_CADENA()
'
'VALORA LA RESPUESTA PARA FINALIZAR
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
ini = 2 'fila inicio
k = 1
h2.Cells.ClearContents
For i = ini To h1.Range("AT" & Rows.Count).End(xlUp).Row
If InStr(1, h1.Cells(i, "AU"), "|") > 0 Then
cad = Split(h1.Cells(i, "AU"), "|")
For j = LBound(cad) To UBound(cad)
h2.Cells(k, "A") = h1.Cells(i, "AT")
h2.Cells(k, "B") = cad(j)
k = k + 1
Next j
Else
'
h2.Cells(k, "A") = h1.Cells(i, "AT")
h2.Cells(k, "B") = h1.Cells(i, "AU")
k = k + 1
'
End If
Next i
'
h2.Cells.EntireColumn.AutoFit
MsgBox "Fin"
End Sub