¿Cómo separar texto de una celda Excel en columnas y filas variables?
Lo que necesito hacer es separar texto de una celda, de bases de datos de cientos de filas, en varias columnas y en una cantidad variable de filas, según los argumentos de cada celda. Se trata de una base de datos de publicaciones científicas, de la cual extraigo información manualmente hoy en día.
Sólo debo separar la información relacionada a autores de nuestra institución, aunque si lo hiciera para todas las instituciones, podría ser hasta más útil. El número de autores puede variar de una publicación a otra, por lo que el número de filas variará, ya que requiero que cada autor quede en una fila independiente, aunque conservando los datos comunes del registro original. Además, a partir de la misma celda, debo generar nuevas columnas que contengan información de filiación a facultades, departamentos, institutos, centros, y ciudad.
Asi se ven los datos originales:
*Me interesa particularmente procesar la información de nuestra institución (Universidad B). El texto no viene en negrita, yo lo puse para destacarlo, lo cual también sería genial si se pudiera hacer automáticamente.
Y así necesito que queden:
¿Habrá alguna macro capaz de hacer esto que me pudieran compartir?
H o l a: Te anexo la macro para realizar la separación.
Hay que considerar lo siguiente:
- Pon tu información en la hoja1
- El resultado quedará en la hoja2
- Cambia en la macro "Universidad B", por el nombre que vas a buscar.
- Los nombres de los autores deben estar entre llaves [ ]
- La separación de los nombres de los autores debe ser con punto y coma ;
- Los datos de filiaciones, instituciones, ciudades, etc, deberán estar separados por coma,
- La macro te generar una fila por cada autor.
- La macro te pone la información en la columna por cada filiación, institución, etc. El único detalle, es que la macro no puede identificar si se trata de una filiación o una institución o una ciudad, solamente pondrá el dato en una nueva columna.
Todo lo que estableciste en tu ejemplo la macro lo considera tal cual y lo plasma en la hoja2.
La macro:
Sub SepararTexto()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
h2.Cells.ClearContents
h1.Rows(1).Copy h2.Rows(1)
'
j = 2
univ = "Universidad B"
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
texto = h1.Cells(i, "C")
n = InStr(1, texto, univ)
If n > 0 Then
ini = InStrRev(texto, "[", n)
If ini > 0 Then
fin = InStrRev(texto, "]", n)
If fin > 0 Then
n = fin
End If
autor = Mid(texto, ini + 1, fin + 1 - ini - 2)
autores = Split(autor, ";")
fin2 = InStr(n, texto, "[")
If fin2 > 0 Then
resto = Mid(texto, n + Len(univ) + 4, fin2 - (n + Len(univ) + 5))
restos = Split(resto, ",")
End If
'
For k = LBound(autores) To UBound(autores)
h2.Cells(j, "A") = h1.Cells(i, "A")
h2.Cells(j, "B") = h1.Cells(i, "B")
h2.Cells(j, "C") = Trim(autores(k))
m = Columns("D").Column
For l = LBound(restos) To UBound(restos)
h2.Cells(j, m) = Trim(restos(l))
m = m + 1
Next
j = j + 1
Next
End If
End If
Next
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Gracias Dante Amor! En todo caso, encontré algunos detalles que se ven en la siguiente imagen:
Agregué observaciones y marqué en rojo el texto incorrecto.
Creo que lo más fácil es que se creen n columnas, siendo n el número de datos de filiación que contenga la publicación con más datos de filiación. Es decir, si una publicación tuviera 10 datos separados por coma, la macro debería crear 10 columnas. Y en el caso de las que tengan menos, sólo ocuparán el número de columnas equivalente a la cantidad de palabras de filiación separadas por coma que contenga esa publicación (2, 3, 4, etc.), dejando en blanco las siguientes columnas.
La otra complicación es que, aunque perfeccionaras esta macro y funcionara sin ningún error, el ejemplo es muy resumido respecto de la base real. ¿Podrías intentarlo con los datos reales?
Aquí hay un enlace a un archivo ("Ejemplo 10 publicaciones reales.xlsx") en el que dejé sólo 10 registros de ejemplo en la Hoja 1 y como deberían quedar en la Hoja 2.
https://www.dropbox.com/s/t1i9iw4n56o1aja/Ejemplo%2010%20publicaciones%20reales.xlsx?dl=0
En verde marqué las columnas que debería copiar de la base original. En amarillo, columna X, está la información que hay que separar en las nuevas columnas y filas.
¿Crees que podrías ayudarme nuevamente? Es sin apuro. Muchas gracias nuevamente!
Saludos!
Víctor
Envíame el archivo, en la hoja1 me pones los datos originales y en la hoja "resultados" pones la información como la necesitas.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Victor Hugo Rocco Toloza” y el título de esta pregunta.
Hola Dante, te acabo de enviar el correo con el archivo.
Muchas gracias por tus disposición.
Saludos,
Víctor
Te anexo la macro actualizada con las columnas reales y las columnas completas
Sub SepararTexto()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
h2.Cells.Clear
h1.Range("A1,J1,K1,N1,O1,X1").Copy h2.[A1]
h1.Range("Y1,Z1,AT1,AU1,AV1,BA1,BB1,BD1").Copy h2.[N1]
'
j = 2
univ = "Univ Andres Bello"
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
texto = h1.Cells(i, "X")
n = InStr(1, texto, univ)
If n > 0 Then
ini = InStrRev(texto, "[", n)
If ini > 0 Then
fin = InStrRev(texto, "]", n)
If fin > 0 Then
n = fin
End If
autor = Mid(texto, ini + 1, fin + 1 - ini - 2)
autores = Split(autor, ";")
fin2 = InStr(n, texto, "[") - 1
If fin2 > 0 Then
resto = Mid(texto, n + Len(univ) + 4, fin2 - (n + Len(univ) + 5))
restos = Split(resto, ",")
Else
resto = Mid(texto, n + Len(univ) + 4)
restos = Split(resto, ",")
End If
'
For k = LBound(autores) To UBound(autores)
h2.Cells(j, "A") = h1.Cells(i, "A")
h2.Cells(j, "B") = h1.Cells(i, "J")
h2.Cells(j, "C") = h1.Cells(i, "K")
h2.Cells(j, "D") = h1.Cells(i, "N")
h2.Cells(j, "E") = h1.Cells(i, "O")
h2.Cells(j, "F") = Trim(autores(k))
m = Columns("G").Column
For l = LBound(restos) To UBound(restos)
h2.Cells(j, m) = Trim(restos(l))
m = m + 1
Next
h1.Range("Y" & i & ",Z" & i & ",AT" & i & ",AU" & i & ",AV" & i & _
",BA" & i & ",BB" & i & ",BD" & i).Copy h2.Range("N" & j)
j = j + 1
Next
End If
Else
'No existe la univ, entonces se copian las columnas
h1.Range("A" & i & ",J" & i & ",K" & i & ",N" & i & ",O" & i & ",X" & i).Copy h2.Range("A" & j)
h1.Range("Y" & i & ",Z" & i & ",AT" & i & ",AU" & i & ",AV" & i & _
",BA" & i & ",BB" & i & ",BD" & i).Copy h2.Range("N" & j)
j = j + 1
End If
Next
MsgBox "Fin"
End SubNo olvides cambiar la valoración a la respuesta.
¡Muchas Gracias! ¡Ahora sí que funciona perfecto! No sabes cuánto trabajo me ahorra la automatización de este proceso. Además, ya no tendré errores por típeo u omisión, así que resulta mucho más confiable. Gran trabajo.
