jueves, 10 de abril de 2014

VBA: Cómo transponer datos según cambio de criterio.

Automatizaremos hoy, mediante una macro, un proceso que transponga nuestros datos de vertical a horizontal según los diferentes cambios o saltos que se produzcan en uno de los campos.

Veamos un ejemplo donde aclarar la misión del día. En el listado siguiente tenemos tres campos, en los que el primero de ellos tiene agrupados los diferentes Códigos, y para código se detallan un número indeterminado de elementos en el campo DETALLE::

VBA: Cómo transponer datos según cambio de criterio.


El objetivo es llegar a:

VBA: Cómo transponer datos según cambio de criterio.



El objetivo queda algo más claro ahora, debemos conseguir transponer los valores del DETALLE para cada cambio en el CÓDIGO.

Así añadiremos nuestro código, macro Transponer, en un módulo de nuestro proyecto VBA:

Sub Transponer()
Dim fila As Long, filaN As Long, columna As Long
'seleccionamos la hoja con el orgien de datos
Sheets("hoja2").Select
Set miRango = Sheets("Hoja2").Range("B2:B41")
A = Application.WorksheetFunction.CountA(miRango)

fila = 1
'CÓDIGO
Hoja4.Range("A1").Value = Hoja2.Range("B1").Value
'CLIENTE
Hoja4.Range("B1").Value = Hoja2.Range("C1").Value
'DETALLE
Hoja4.Range("C1").Value = Hoja2.Range("D1").Value

'definimos punto de partida para recorrer celdas
filaN = 1: columna = 2
'hacemos un loop para pasar por todos los registros
For i = 1 To A
    fila = fila + 1
    'cuando el Código sea el mismo que el anterior
    If Hoja2.Range("B" & fila) = Hoja2.Range("B" & fila - 1) Then
        'nos desplazamos una columna a la izquierda
        columna = columna + 1
        Hoja4.Cells(filaN, columna).Offset(0, 1).Value = Hoja2.Cells(fila, 4).Value
    Else
        'si no es el mismo, plasmamos los valores correspondientes
        filaN = filaN + 1
        Hoja4.Cells(filaN, 1).Value = Hoja2.Cells(fila, 2)
        Hoja4.Cells(filaN, 2).Value = Hoja2.Cells(fila, 3)
        Hoja4.Cells(filaN, 3).Value = Hoja2.Cells(fila, 4)
        'fijamos de nuevo para la comparativa a la columna B
        columna = 2
    End If
Next i
'liberamos la variable
Set miRango = Nothing
End Sub



Tras ejecutar nuestra macro, observaremos que por cada cambio o salto en el campo CÓDIGO se transponen los diferentes valores asociados a ese CÓDIGO para el campo DETALLE, independientemente del número de elementos para cada Código.

6 comentarios:

  1. No me sirve el codigo, me puede ayudar por favor.

    ResponderEliminar
  2. Este es el código para Excel 2013 en adelante.


    Sub Macro1()

    Dim fila As Long, filaN As Long, columna As Long
    'seleccionamos la hoja con el orgien de datos
    Sheets("hoja2").Select
    Set miRango = Sheets("Hoja2").Range("B2:B41")
    A = Application.WorksheetFunction.CountA(miRango)

    fila = 1
    'CÓDIGO
    Worksheets("Hoja4").Range("A1").Value = Worksheets("Hoja2").Range("B1").Value
    'CLIENTE
    Worksheets("Hoja4").Range("B1").Value = Worksheets("Hoja2").Range("C1").Value
    'DETALLE
    Worksheets("Hoja4").Range("C1").Value = Worksheets("Hoja2").Range("D1").Value

    'definimos punto de partida para recorrer celdas
    filaN = 1: columna = 2
    'hacemos un loop para pasar por todos los registros
    For i = 1 To A
    fila = fila + 1
    'cuando el Código sea el mismo que el anterior
    If Worksheets("Hoja2").Range("B" & fila) = Worksheets("Hoja2").Range("B" & fila - 1) Then
    'nos desplazamos una columna a la izquierda
    columna = columna + 1
    Worksheets("Hoja4").Cells(filaN, columna).Offset(0, 1).Value = Worksheets("Hoja2").Cells(fila, 4).Value
    Else
    'si no es el mismo, plasmamos los valores correspondientes
    filaN = filaN + 1
    Worksheets("Hoja4").Cells(filaN, 1).Value = Worksheets("Hoja2").Cells(fila, 2)
    Worksheets("Hoja4").Cells(filaN, 2).Value = Worksheets("Hoja2").Cells(fila, 3)
    Worksheets("Hoja4").Cells(filaN, 3).Value = Worksheets("Hoja2").Cells(fila, 4)
    'fijamos de nuevo para la comparativa a la columna B
    columna = 2
    End If
    Next i
    'liberamos la variable
    Set miRango = Nothing

    End Sub

    ResponderEliminar
    Respuestas
    1. Hola Álvaro,
      qué no te funciona??
      Parece que el código es el mismo que el del post???

      Saludos

      Eliminar
    2. La "Hoja4" es donde se quiere ubicar la nueva tabla?

      Eliminar
    3. Me sale este error

      "Se ha producido el error '424' en tiempo de ejecución:

      Se requiere un objeto"

      Eliminar
    4. Hola,
      te has asegurado que existe una hoja que se llama exactamente 'Hoja4' ??

      Slds

      Eliminar