Excel: Encontrar grupos de 4 letras o mas en rango de celdas
Lo siento Luis pero Hay cosillas que no puedo resolver, me podrías apoyar nuevamente?
Con respecto a tu código:
Sub letras() columna = ActiveCell.Offset(0, 1).Column tope = Len(ActiveCell) Do While ActiveCell.Value <> "" For x = 1 To tope + 1 extrae = Mid(ActiveCell, x, 1) If extrae = "" And Len(lista) > 3 Then Cells(ActiveCell.Row, columna).Value = lista lista = "" columna = columna + 1 End If If Not IsNumeric(extrae) Then lista = lista & extrae End If If IsNumeric(extrae) And Len(lista) > 3 Then Cells(ActiveCell.Row, columna).Value = lista lista = "" columna = columna + 1 End If If IsNumeric(extrae) And Len(lista) < 3 Then lista = "" End If Next ActiveCell.Offset(1, 0).Select columna = ActiveCell.Offset(0, 1).Column Loop End Sub
Bueno pues si hace el recorrido y extrae las letras, pero todos los resultados los imprimía en la columna siguiente en la <<fila 1 >>, leyendo un poquito los manuales que hay en linea y rezándole a San Google, pues encontré útil reemplazar el numero de celda por fila activa
Antes: Cells(1, columna).Value = lista
Después: Cells(ActiveCell.Row, columna).Value = lista
Y voila! Todo bien, pero encontré una falla,
MARTINEZ119 (aquí todo bien, pues trae MARTINEZ)
ORD37730493 (auí también por que no trae nada, eso es correcto)
FNA98265CHO (aquí empieza el problema, pues trae ORDFNA, o sea revuelve el anterior)
ORD37740964 (CHOORD)
ORD37741081 (aquí bien por que no trae nada)
ORD37731881 ORDORD
Y pues, esa es la situación.
1 Respuesta
Te mando la macro que soluciona lo de la fila para que lo vaya anotando fila por fila
Sub letras() 'por luismondelo columna = ActiveCell.Offset(0, 1).Column fila = ActiveCell.Row Do While ActiveCell.Value <> "" tope = Len(ActiveCell) For x = 1 To tope + 1 extrae = Mid(ActiveCell, x, 1) If extrae = "" And Len(lista) > 3 Then Cells(fila, columna).Value = lista lista = "" columna = columna + 1 End If If Not IsNumeric(extrae) Then lista = lista & extrae End If If IsNumeric(extrae) And Len(lista) > 3 Then Cells(fila, columna).Value = lista lista = "" columna = columna + 1 End If If IsNumeric(extrae) And Len(lista) < 3 Then lista = "" End If Next ActiveCell.Offset(1, 0).Select columna = ActiveCell.Offset(0, 1).Column fila = ActiveCell.Row Loop End Sub
recuerda finalizar la consulta
Hola
Gracias por la atención, bueno a lo mejor mi pequeñísima contribución al código no era la correcta, pero éste ya hacia el recorrido correctamente, mas bien el problema que trataba de explicar es que revuelve algunos caracteres, en la ultima fila del ejemplo trae tres letras de la celda actual mas tres letras de la celda anterior, será que se pueda arreglar eso?
Buen fin de semana!
Ahhh ahora te entendí. Te mando la macro con unas modificaciones. Lo puedes probar con el ejemplo que mandaste en tu anterior post.
Sub letras() 'por luismondelo columna = ActiveCell.Offset(0, 1).Column fila = ActiveCell.Row Do While ActiveCell.Value <> "" tope = Len(ActiveCell) For x = 1 To tope + 1 extrae = Mid(ActiveCell, x, 1) If extrae = "" And Len(lista) > 3 Then Cells(fila, columna).Value = lista lista = "" columna = columna + 1 End If If Not IsNumeric(extrae) Then lista = lista & extrae End If If IsNumeric(extrae) And Len(lista) > 3 Then Cells(fila, columna).Value = lista lista = "" columna = columna + 1 End If If extrae = "" And Len(lista) <= 3 Then lista = "" End If If IsNumeric(extrae) And Len(lista) <= 3 Then lista = "" End If Next ActiveCell.Offset(1, 0).Select columna = ActiveCell.Offset(0, 1).Column fila = ActiveCell.Row Loop End Sub
recuerda finalizar
