array(vba).htm

Transponera data mellan kolumn och rader

I detta tips visas hur vi relativt enkelt och snabbt kan flytta data mellan en kolumn och rader, dvs transponera data.

Förutsättningar för exemplet:

Varje post omfattar 9 celler i kolumn A.

Mellan varje post finns det en tomrad.

Varje post ska presenteras på en rad med start i B-kolumnen och den tomma cellen ska inte följa med övrig data.

Option Explicit

Option Base 1

Sub Transponera_Data()

   '© 2002 Alla rättigheter Tommy Bak
   'Reviderad av & XL-Dennis

   Dim wsBok As Workbook

   Dim wsBlad As Worksheet

   Dim lnAntal1 As Long, lnAntal2 As Long

   Dim lnSistaRaden As Long, lnAntalRader As Long, lnStorlek As Long

   Dim vaData1 As Variant, vaData2 As Variant

   Set wsBok = ThisWorkbook

   Set wsBlad = wsBok.Worksheets("Blad1")

   'Antal rader varje post innefattar inklusive en tomrad nedanför posten.

   lnAntalRader = 10

   lnSistaRaden = Range("A65536").End(xlUp).Offset(1, 0).Row

   Application.ScreenUpdating = False

   With wsBlad

      vaData1 = .Range("A1:A" & lnSistaRaden).Value

   End With

   ReDim vaData2(lnSistaRaden, lnAntalRader)

   'Här överförs data från den första arrayen till den andra

   For lnAntal1 = 1 To lnSistaRaden Step lnAntalRader

      lnStorlek = lnStorlek + 1

      For lnAntal2 = 1 To lnAntalRader

         'Vid tilldelningen av data tas tomraden för varje post tas bort.

         vaData2(lnStorlek, lnAntal2) = vaData1(lnAntal1 + lnAntal2 - 1, 1)

      Next lnAntal2

   Next lnAntal1

   'Här tilldelas det horisontella cellområdet data, exklusive tomraderna från kolumnen.

   With wsBlad

      .Range("B1").Resize(lnStorlek, lnAntalRader - 1) = vaData2

      .Columns("A:A").Delete

   End With

   Application.ScreenUpdating = True

End Sub