Extraer de cadenas de texto y agrupar en otra columna, atendiendo a un tamaño mínimo por palabra.
No quisiera abusar de algún experto en concreto, por eso lo lanzo también a la Comunidad, aunque a algunos expertos habría que darles una placa o una mención honorífica, porque tanta ayuda y desinteresadamente, no la hay mucha en este mundo.
Mi caso es éste:
Estoy tratanto con una hoja de Excel, en la que tengo hasta 1650 filas en las que aparecen descripciones en formato texto.
Necesitaría extraer de esa columna a otra columna la palabras que tengan más de 5 caracteres, quedando en la misma fila, pero separadas por una coma. Debe ser una macro, ya que tengo que realizar otras operaciones y las tengo preparadas en otro fichero de macros.
Este es un ejemplo de lo que necesito:
Y vuelta a dar las
2 Respuestas
Aquí te dejo la macro que hace lo que has solicitado.
Ponla en ThisWorkBook y asóciala a un botón o a una combinación de teclas.
Sub Extrae_Palabras() '(c) Marcial Castro Nc = 5 ' Número de caracteres mínimo de cada palabra a Extraer Lin_Ext = 1 ' Fila donde comienzan las frases Lin_Pal = 1 ' Fila donde comienzan las palabras extraidas Col_Ext = "C" ' Columna donde comienzan las frases Col_Pal = "Y" ' Columna donde comienzan las palabras extraidas 'Leemos la PRIMERA frase frase = Application.WorksheetFunction.Trim(Range(Col_Ext & Lin_Ext).Value) Do 'Esto no hace falta pero por si te interesa es el número de palabras de cada frase NPalabras = UBound(Split(frase)) + 1 For Each pal In Split(frase) ' Con la función Split recorremos cada palabra If Len(pal) >= Nc Then cadena = cadena & pal & "," ' Añadimos la palabra a la cadena si es mayor de Nc caracteres End If Next 'Quitamos la última coma cadena = Left(cadena, Len(cadena) - 1) ' Grabamos la cadena que tiene las palabras Range(Col_Pal & Lin_Pal).Value = cadena ' La inicializamos para la siguiente frase cadena = "" ' Aumentamos en 1 las filas de extracción y de las palabras Lin_Pal = Lin_Pal + 1 Lin_Ext = Lin_Ext + 1 'Leemos la siguiente frase frase = Application.WorksheetFunction.Trim(Range(Col_Ext & Lin_Ext).Value) Loop While frase <> "" ' Mientras no sea una celda vacía la siguiente frase, repetimos el proceso End Sub
¡Gracias! y no sólo gracias.
Eres un fenómeno.
Funciona correctamente.
Saludos, Santiago.
Hola Marcial,
Como te comenté la macro en solitario funciona de miedo.
Pero tengo un inconveniente. Cuando coloco la macro en el lugar que corresponde a la que ya tenía, me da un error 13. (La variable o propiedad no es del tipo correcto.)
Posiblemente deba declarar la variable "frase" en un DIm, algo parecido a lo que he intentado, pero no sé...
Es correcto?
Nuevamente agradecido, Santiago.
Por lo que puedo ver en esa imagen, has declarado la variable 'frase' como integer, de ahí el error.
Perdona Marcial que no te haya respondido, pero he estado pachucho.
A ver si lo miro y te comento.
Gracias mil por tu respuesta.
Santiago.
Hola Marcial, ya he visto que me has respondido a la otra pregunta tú también. Eres un fiera de VBA.
Gracias.
En relación a ésta, que probé y funcionó. Una vez integrada en mi macro y eliminado el Dim que no correspondía, he hecho alguna prueba y me ocurre que me funciona cuando extra palabras de 4 ó menos caracteres, para 5 ó más se me interrumpe, me da "error 5 en tiempo de ejecución".
Podrías decirme, si se te ocurre algo al respecto, qué puede pasar?
Gracias.
Saludos, Santiago.
No sé lo que te puede pasar si no veo el código. Envíame el fichero.
Te anexo la macro
Sub ExtraerCadenas()
'Por.Dante Amor
For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
cad = Split(Cells(i, "C"), " ")
For j = LBound(cad) To UBound(cad)
If Len(cad(j)) > 5 Then fin = fin & cad(j) & ","
Next
If fin <> "" Then Cells(i, "Y") = Left(fin, Len(fin) - 1)
fin = ""
Next
End Sub
Estimado Dante, no fallas una !!!
Funciona de maravilla. Al integrarla en mi macro no da problemas.
Excelente tu aporte.
Saludos, Santiago.