Macro VBA excel para duplicar registros en base de datos con cierta condición y depurarlos

He aprendido mucho en todo este año y medio que llevo sin participar en estos foros, hoy vuelvo a mis raíces, tengo el siguiente problema.

Tengo una base de datos que trae diferentes registros, la idea, como toda base de datos, es que vengas los datos independientes, pero desafortunadamente la fuente para algunos casos me trae los datos de la siguiente manera:

Si lo notan para la variable 3 en los registros de España y USA el lenguaje (español/ingles/otros) vienen mezclados.

Variable 1 Variable 2 Variable 3
Colombia Bogota Español
Argenita Buenos aires Español
Mexico Ciudad de mexico Español
España        Madrid            Español/Ingles
USA Washintong Ingles/Español/Otros

Requiero una macro que me separe esos registros de la siguiente manera.

Variable 1 Variable 2 Variable 3
Colombia Bogotá Español
Argenita Buenos aires Español
México Ciudad de méxico Español
España Madrid Español
España Madrid Ingles
USA Washintong Ingles
USA Washintong Español
USA Washintong Otros

Como dato adicional, mi BBDD solo trae esa condicion en una variable, y al igual que el ejemplo separa con un " / ", y adicional, puede traer varias mezclados, de 2 en adelante, puede haber hasta 15 idiomas en una misma celda.

1 respuesta

Respuesta
1

Asumiendo tus datos en las columnas A, B y C. Los resultados en las columnas E, F y G:

Sub duplicar_registros()
  Dim c As Range, v As Variant
  Application.ScreenUpdating = False
  For Each c In Range("A2", Range("A" & Rows.Count).End(3))
    For Each v In Split(c.Offset(, 2), "/")
      Range("E" & Rows.Count).End(3)(2).Resize(1, 3).Value = Array(c, c.Offset(, 1), v)
    Next
  Next
End Sub

Dante, como siempre, me ayudas muchísimo, estamos cerca de lo que requiero, creí que podía ajustar el código a mi necesidad, pero no lo logré, ese fue un ejemplo que usé para hacer más entendible el ejercicio, en la realidad mi BBDD tiene 18 columnas (hasta la R en excel) y es en la columna 13 donde tengo los datos mezclados y diferenciados con el " / ", requiero tal cual lo mismo, pero que me copie las 18 columnas y las pegue en la columna T y que la separación la realice con la variable de la columna M.

Prueba lo siguiente:

Sub duplicar_registros_2()
'Declaración de variables
  Dim a As Variant, b As Variant
  Dim i As Long, j As Variant, k As Long, lr As Long, m As Long, n As Long
'Entrada de datos
  lr = Range("M" & Rows.Count).End(3).Row
  a = Range("A2:R" & lr).Value2
  m = Evaluate(Replace("=MAX(LEN(@)-LEN(SUBSTITUTE(@,""/"","""")))", "@", "M2:M" & lr & ""))
  ReDim b(1 To UBound(a) * (m + 1), 1 To 18)
'Proceso
  For i = 1 To UBound(a, 1)
    For Each j In Split(a(i, 13), "/")
      k = k + 1
      For n = 1 To 18
        b(k, n) = a(i, n)
      Next n
      b(k, 13) = j
    Next j
  Next i
'Salida
  Range("T2").Resize(k, 18).Value = b
End Sub

¡Gracias! 

Perfecto como siempre mi amigo Dante, ¡sos un crack!

Me alegra ayudarte, no olv ides valorar. Gra cias por comentar.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas