Referente a: Separar cadena de texto en Filas según el número de caracteres
Disculpa si no es la mejor manera de hacer la consulta, pero es que ando un poco perdido y navegando por la red, he visto una consulta que te hicieron sobre una macro y se acerca mucho a lo que estoy buscando pero no consigo aclararme.
La consulta es sobre separar palabras completas de unos celdas determinados, pero lo que difiere de la consulta anterior es que a mi me gustaría que el resultado se mostrara en columnas. Por ejemplo:
"Tengo un texto que quiero separar" en hoja 1 Celda B2
"Tengo un texto" en hoja 2 Celda A2 "que quiero" en hoja 2 Celda B2 "separar" en hoja 2 C2 y así sucesivamente en filas posteriores.
La verdad que ando un poco pez con el lenguaje Visula Basic y no se modificar tu macro para ello.
En mi caso solo necesito 15 caracteres, eso y el cambio de columna lo tengo claro pero para las filas ya me pierdo.
Si me pudieras ayudar, me harías un gran favor.
Un saludo, y gracias por anticipado.
Esta es la que solucionó la duda anterior:
Sub separar()
'Por.DAM
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
h2.Columns("A").Clear
'
k = 75
j = 1
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
If Len(h1.Cells(i, "A").Text) > k Then
nva = h1.Cells(i, "A")
Do While Len(nva) > k
n = InStrRev(nva, " ", k + 1)
If n > 0 Then
h2.Cells(j, "A") = RTrim(Left(nva, n))
nva = Mid(Mid(nva, 2), n)
Else
n = InStr(1, nva, " ")
If n = 0 Then n = Len(nva)
h2.Cells(j, "A") = RTrim(Left(nva, n))
nva = Mid(nva, n)
End If
j = j + 1
Loop
If Len(nva) > 0 Then
h2.Cells(j, "A") = nva
j = j + 1
End If
Else
h2.Cells(j, "A") = h1.Cells(i, "A")
j = j + 1
End If
Next
h2.Select
MsgBox "Separación terminada", vbInformation
End Sub
3 respuestas
Te anexo la macro actualizada
Sub separar()
'
' Por.Dante Amor
'
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
k = 15 'número de caracteres de cada cadena
'
h2.Cells.Clear
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
col = 1
If Len(h1.Cells(i, "A").Text) > k Then
nva = h1.Cells(i, "A")
Do While Len(nva) > k
n = InStrRev(nva, " ", k + 1)
If n > 0 Then
h2.Cells(i, col) = RTrim(Left(nva, n))
nva = Mid(Mid(nva, 2), n)
Else
n = InStr(1, nva, " ")
If n = 0 Then n = Len(nva)
h2.Cells(i, col) = RTrim(Left(nva, n))
nva = Mid(nva, n)
End If
col = col + 1
Loop
If Len(nva) > 0 Then
h2.Cells(i, col) = nva
col = col + 1
End If
Else
h2.Cells(j, col) = h1.Cells(i, "A")
col = col + 1
End If
Next
h2.Select
h2.Cells.EntireColumn.AutoFit
MsgBox "Separación terminada", vbInformation
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Muchas Gracias Dante Amor!
Me da error en la línea
h2.Cells(j, col) = h1.Cells(i, "A")
Si necesitas el archivo, te lo envío sin problemas.
Un saludo.
Cambia esa línea por esta
h2.Cells(i, col) = h1.Cells(i, "A")
Muchas gracias!!
Ahora es ideal,!! Solo una pequeña duda, ¿es posible que solo se modifiquen en la hoja 2, las celdas afectadas y las otras las deje como están?
Con la ayuda que me has ofrecido me es mas que suficiente, esto no deja de ser un extra.
Muchísimas gracias por todo!!
No entendí. Tendrás que explicarlo con unos de ejemplos de lo que tienes y de lo que esperas de resultado. Con mucho gusto te ayudo con todas tus peticiones.
Crea una nueva pregunta en Todoexpertos.com dentro del tema de microsoft excel. En el desarrollo de la pregunta escribe: "para Dante Amor". Ahí me describes con detalle lo que necesitas.
Sal u dos
Esto te puede aportar algo más