Separar frase por largo en dos columnas, 1ra 100 caracteres, 2da resto, separar por palabras completas
Necesito ayuda para poder terminar una macro,
Tengo una hoja con 10.000 filas, cada fila, en columna A, contiene frases de largo diferente.
El largo máximo de cada frase no debe superar los 100 caracteres.
Lo que debo hacer, en columna C y DE es:
Columna C, debe contener la frase con un máximo de 100 caracteres, en el caso de que los caracteres superen los 100, debo colocar la diferencia sobrante en la columna D.
Esto me sale ok con la siguiente macro, que detallo, el problema es que el texto sobrante no separa en palabras completas, y queda la frase desprolija y toda cortada -..
Yo debería buscar un espacio y recortar por palabra completa…
Separada en silabas, se que debo usar MId, o INSTr, peo no me sale..
Espero haber sido clara, sino me preguntan, paso ejemplos.
Millones de gracias,!
Sub modifcartexto1()
Largo = 100 'Es el valor que debe tener como maximo la celda
Fila = 1
FInal = Hoja1.Cells(1, 1).End(xlDown).Row
For Fila = 1 To FInal
Texto = Hoja1.Range("A" & Fila) 'Lugar de origen de la frase
Largof = Len(Texto) 'Es el largo de la frase
For X = 1 To Largof
If Largof > Largo Then
Diferencia = Largof - Largo 'Es lo que debo recortar de la frase
Cien = Largof - Diferencia ' Es el largo que queda de la frase recortada
Resto = Right(Texto, Diferencia) 'el texto recortado ira a una nueva columna
Txt100 = Left(Texto, Cien) 'el texto que se permite como máximo en la otra nueva columna
Hoja1.Range("D" & Fila) = resto 'traslado el sobrante de el largo de la frase
Hoja1.Range("C" & Fila) = Txt100 'traslado el texto de 100 caracteres como maximo
Else
Hoja1.Range("C" & Fila) = Texto 'Si frase es menor o igual a 100 lo paso a la columna de texto permitido
End If
Next X
Next Fila
End Sub
Ejemplo:
Texto Original Columna A (Filas 1 a 11)
Verr /Vinie:Cabaut y Cia.;Enciclop.Univ.Ilustrada Europa y Améric., editorial 1932, Editorial Espasa Calpe
Verr /Vinie:Cabaut y Cia.;Enciclop.Univ.Ilustrada Europa y Améric., editorial 1932,. ¿Cómo me llamo? Nancy y vos
Verr /Vinie:Cabaut y Cia.;Enciclop.Univ.Ilustrada Europa y Améric., editorial 1932,. ¿Cómo me llamo? Nancy y vos
Rossi, Floreal:Stella;Geografia de America y Antartida 3° año, editorial 1980, Editorial Espasa Calpe, Año 1967
Quarleri, Paulina:Kapeluz;Geografia Asia y Africa 1° año, editorial 1981,. Y un paìs para todos
Passadori, Josefina:Kapeluz;Geografia Asia y Africa, editorial 1966,.
Otero, José Pacífico:Cabaut y Cia.;Historia del Libert. Gral. San Martín, editorial 1932,.
Nuñez de Arce, Gaspar:Montaner y Simón;Obras escogidas, editorial 1911,. ¿Cómo me llamo? Nancy y vos
Libro:Zoologia 6;Claus, C, editorial Montaner y Simon, 1920.
Libro:Zoologia 4;Claus, C, editorial Montaner y Simon, 1920.
Libro:Zoologia 3;Claus, C, editorial Montaner y Simon, 1920. ¿Cómo me llamo? Nancy y vos cuidateeeeee mucho
Resultado en Columna C, Cada fila 100 caracteres
Verr /Vinie:Cabaut y Cia.;Enciclop.Univ.Ilustrada Europa y Améric., editorial 1932, Editorial Espasa
Verr /Vinie:Cabaut y Cia.;Enciclop.Univ.Ilustrada Europa y Améric., editorial 1932,. ¿Cómo me llamo? N
Verr /Vinie:Cabaut y Cia.;Enciclop.Univ.Ilustrada Europa y Améric., editorial 1932,. ¿Cómo me llamo? N
Rossi, Floreal:Stella;Geografia de America y Antartida 3° año, editorial 1980, Editorial Espasa Calpe,
Quarleri, Paulina:Kapeluz;Geografia Asia y Africa 1° año, editorial 1981,. Y un paìs para todos
Passadori, Josefina:Kapeluz;Geografia Asia y Africa, editorial 1966,.
Otero, José Pacífico:Cabaut y Cia.;Historia del Libert. Gral. San Martín, editorial 1932,.
Nuñez de Arce, Gaspar:Montaner y Simón;Obras escogidas, editorial 1911,. ¿Cómo me llamo? Nancy y vos
Libro:Zoologia 6;Claus, C, editorial Montaner y Simon, 1920.
Libro:Zoologia 4;Claus, C, editorial Montaner y Simon, 1920.
Libro:Zoologia 3;Claus, C, editorial Montaner y Simon, 1920. ¿Cómo me llamo? Nancy y vos cuidateeeeee mu
Columna D = Texto sobrante
Calpe
Ancy y vos
Ancy y vos
Año 1967
Cho
1 Respuesta
Prueba con:
Sub prueba()
Dim r As Range, c As Range
With Worksheets("Hoja1")
Set r = .[A1].Resize(.[A1].End(xlDown).Row)
For Each c In r
c.Offset(, 2).Value = Left(c.Value, InStrRev(Left(c.Value, 100), " ") - 1)
c.Offset(, 3).Value = Mid(c.Value, InStrRev(Left(c.Value, 100), " ") + 1)
Next c
End With
End SubSaludos_
¡Gracias!
No entiendo bien la macro, pero funcionó de maravillas.
Gracias infinitas :)
Vos sabes que estuve con mucho lìo, ejecute la macro funcionó y fui feliz.
Ahora que la miro, la verdad es que si hubiera pensado, MUCHO, me hubiese salido en algún remoto año.
InStrRev, esta funciòn, Instr, y Mid, las voy a estudiar como cuando repetìa la Tarea a los 8 años,
Bueno, no te molesto más, perdón si soy confianzuda, no quisiera molestarte.
Te dejo un gran saludo y hasta la próxima burrada que me mande :) Y bue soy autodidacta...
Nancy
No había visto tu último comentario.
_gracias por hacerme sonreír :)
