Macro para separa el contenido de una celda
Estoy intentando separar el contenido de una celda según 3 condiciones ejemplo si el la cel A1, A2, A3
Tengo respectivamente los siguientes valores S9/P7, G8 PL, 8B, donde cada valor tiene 3 condiciones para separa que son el /, el espacio y la B. El resultado que estoy buscando es que al final sobre la misma columna A me queden ordenados hacia abajo S9, P7, G8, PL, 8B, 8B desde la celda A1 hasta la celda A6.
1 Respuesta
Debieras dejar una imagen con el ejemplo de tus datos y cómo los quieres. Hay detalles que me hacen temer de que luego habrá que modificar la macro seguramente.
1- Si tienes datos en A1:A3 no puedes ir tapandolos con el resultado que también los quieres en A1:A6
2- ¿Por qué en tu ejemplo devuelves 8B 2 veces?
Quedo atenta a tus aclaraciones.
Hola elsa gracias de antemano por la ayuda, te envio lo que e intentado con la macro, inicialmente separo los datos con esta macro
Sub InsertaBlancosTIPO_SENAL1()
Dim celda As Range
For Each celda In Range([A2], [A65536].End(xlUp))
If celda.Value = "SP-46A/SR-30" Or celda.Value = "SP-47A/SR-30" Or celda.Value = "SP-47/SR-30" Or celda.Value = "SP-34/SR-30" Or celda.Value = "SP-04/SR-30" Or celda.Value = "SP-25A/SR-30" Or celda.Value = "SR-28 PLAQUETA" Or celda.Value = "SP-46A/SP-24" Then celda.Offset(1, 0).EntireRow.Insert
Next
End Sub
y luego ejecuto esta macro pero me salen algunos errores
Sub SeparaXIDSenal()
'recorre la col A, desde fila 2 hasta encontrar una celda vacía
Range("E4").Select
While ActiveCell <> ""
'ubico el IDSenal recorriendo a izquierda
For i = Len(ActiveCell) To 1 Step -1
If Mid(ActiveCell, i, 1) = "/" Then
ubico = i
Exit For
End If
Next i
If ubico > 1 Then
ActiveCell.Offset(1, 0) = Right(ActiveCell, Len(ActiveCell) - ubico)
ActiveCell.Offset(0, 0) = Left(ActiveCell, ubico - 1)
End If
ActiveCell.End(xlDown).Select
ActiveCell.Offset(0, 0).Select
Wend
End Sub
La idea es que si hay datos que no deben separarse los resultados no los reemplacen o tapen con el resultado, y en el caso que el dato termine en B se duplique en la separación de la macro.
Saludos
No se ven los encabezados de filas y columnas... tendrás que ajustar la macro en algunas líneas.
Sub SeparaXIDSenal()
'recorre la col D, desde fila 2 hasta encontrar una celda vacía
Range("D2").Select
'última fila con datos
X = Range("A" & Rows.Count).End(xlUp).Row + 1
While ActiveCell <> "" And ActiveCell.Row < X
'ubico el IDSenal recorriendo a izquierda
ubico = 0
For i = Len(ActiveCell) To 1 Step -1
If Mid(ActiveCell, i, 1) = "/" Or Mid(ActiveCell, i, 1) = " " Then
ubico = i
Exit For
End If
Next i
If ubico > 1 Then
ActiveCell.Offset(1, 0) = Right(ActiveCell, Len(ActiveCell) - ubico)
ActiveCell = Left(ActiveCell, ubico - 1)
ElseIf Right(ActiveCell, 1) = "B" Then
ActiveCell.Offset(1, 0) = ActiveCell
End If
ActiveCell.End(xlDown).Select
'ActiveCell.Offset(0, 0).Select
Wend
End SubSdos!
