Función Buscar V con más de un dato separado por coma en la misma celda

[renu04]

Buenos días

Tengo un macro configurada con la fórmula buscar V para que me traiga distintos datos, de la hoja 2 a la hoja 1.

funciona correctamente pero hay casos en los cuales en las columnas A y B tengo más de un valor, y obviamente cuando trae los resultados arroja N/A.

Necesito hacer que automáticamente cuando haya en la columna A y/o B más de un valor, agregue una fila debajo con ese valor separado, como si fuera una sólo, de modo que siempre las columnas A y B tenga una sólo valor y la función Buscar V pueda arrojar los resultados que hubiere en la hoja 2.

Tal modificación necesito que la haga previamente a correr la macro con la fórmula para que tenga ya entonces las columnas A y B con un sólo valor.

Muchas gracias por vuestra ayuda

Saludos cordiales

Buscar V .zip

[Toldeman]

Hola.

Corre esta macro y comentas:

Sub Macro1()
'declaramos las variables
Dim x As Long
Dim y As Long
'seleccionamos la primecelda del rango a evaluar
Range("A1").Select
'recorremos cada celda para comprobar si hay mas de un valor
Do
'dentro del bucle nos vamos moviendo una celda abajo
ActiveCell.Offset(1, 0).Select
'le damos un valor a la x y a la y
y = Selection.Row
x = VBA.Len(Range("A" & y))
'construimos una condicion para insertar filas
If x > 1 Then
'construimos una matriz con los valores de la celda que tiene mas de un caracter
arr = Split(Range("A" & y), ",")
'sustituimos las comas y los espacios si los hubiese
Range("A" & y) = Replace(Range("A" & y), ",", "")
Range("A" & y) = Replace(Range("A" & y), " ", "")
'la variable x cogera el nuevo valor
x = VBA.Len(Range("A" & y))
'construimos un bucle para insertar las filas necesarias
For i = 1 To x - 1
Range("A" & y).Offset(1, 0).Select
Selection.Insert Shift:=xlDown
Next
'una vez insertadas las filas volcamos los valores en las celdas vacias
Range("A" & y).Resize(x) = Application.Transpose(arr)
End If
'quitamos espacios en blanco que hay al usar la proipedad Resize
Range("A2:A" & y).Replace what:=" ", replacement:=""
Loop While ActiveCell <> ""
End Sub

Un saludo.

[renu04]

Muchas gracias por tu ayuda

Probé la macro en el ejemplo que te envíe y funciona correctamente, luego lo probé en mi archivo (cambiando las referencias por supuesto), pero no he logrado lo que deseaba.

Te adjunto el archivo original sobre el cual estoy trabajando, y las columnas con doble o triple datos son las columnas O y X; las cuales necesito separar para después traer datos con buscar V desde otra hoja.

Muchas gracias

Saludos cordiales

buscar V.zip

[Toldeman]

Hola.

Es que el ejemplo que subiste primeramente no se parece en nada a este ultimo. La verdad es que no se como quieres que te queden las columnas O y X.

Indica de forma manual algún ejemplo de como debería de quedar.

Saludos.

[renu04]

Como estas?

Quisiera que si en la columna O y X, si hubiera más de un valor separado por coma, se agregue debajo una fila o las que fueran necesarias, dejando un solo valor por fila.

De modo que luego puedo traer para cada valor datos de otra ubicación.

Por ejemplo si en la columna O tengo dos valores, que debajo se agregue otra fila, y que queda el primer valor en la primer fila, y en la agregada debajo, el otro valor en solo una fila, y así sucesivamente si hubiera más de dos.

Subo un archivo como ejemplo.

Saludos cordiales

Te adjunto un ejemplo

Muchas gracias

buscar V reemplazo.zip

[Toldeman]

Hola.

El ejemplo que has subido no lo he visto muy clarificador pero creo que se lo que quieres hacer. Te pongo una macro que te separa todas las palabras o numeros de una celda los cuales esten delimitados por comas.

Condiciones: Que la columna donde se encuentren los datos empiecen de la fila 2 en adelante, aunque esto se podria arreglar si quieres que empiecen en la fila 1. Otra consideracion a tener en cuenta es que la macro se para si hay filas en blanco, tambien se podria arreglar.

Sub separar()
Range("A1").Select
Do
ActiveCell.Offset(1, 0).Select
y = Selection.Row
arr = Split(Range("A" & y), ",")
x = UBound(arr)
If x >= 1 Then
For i = 1 To x
Range("A" & y).Offset(1, 0).Select
Selection.Insert Shift:=xlDown
Next
Range("A" & y).Resize(x + 1) = Application.Transpose(arr)
End If
Loop While ActiveCell <> ""
End Sub

La macro esta para que funcione en la columna A, para otra columna te sera facil modificar el codigo.

Un saludo.

[renu04]

Muchas gracias por tu ayuda

hay posibilidades de hacer que no se la columna A sino las que te habia mencionado y que no se paré en las filas en blanco?

Slds

[Toldeman]

Hola.

Prueba esta:

Sub separar()
ul = Range("A" & Rows.Count).End(xlUp).Row
non = Range("A" & ul).Value
Range("A1").Select
Do
ActiveCell.Offset(1, 0).Select
y = Selection.Row
arr = Split(Range("A" & y), ",")
x = UBound(arr)
If x >= 1 Then
For i = 1 To x
Range("A" & y).Offset(1, 0).Select
Selection.Insert Shift:=xlDown
Next
Range("A" & y).Resize(x + 1) = Application.Transpose(arr)
End If
Loop While ActiveCell.Row <> non
End Sub

Un saludo.