Omvandla rader till kolumner på basis av sidbrytningar

Omvandla rader till kolumner på basis av horisontella sidbrytningar

I detta tips demonstreras en teknik för att omvandla radvärden till kolumnvärden på basis av horisontella automatiska sidbrytningar.

Detta kan komma väl till användning om vi har långa listor i en kolumn där data ska skrivas ut eller för att få en bättre uppställning för vidare bearbetning.

Option Explicit

Sub Rader_Till_Kolumner_Sidbrytning_XL4Makro()
'© 2002 Alla rättigheter XL-Dennis
Dim rnKolumn As Range, rnCell1 As Range, rnCell2 As Range
Dim hSidbrytningar() As Integer, i As Integer, j As Integer

Application.ScreenUpdating = False

Set rnKolumn = ActiveWorkbook.Worksheets("Blad1").Columns(1)

'Här definieras ett namn, vilket refererar till ett XL4 -makro och
'tilldelar matrisen radnummer direkt under de automatiska sidbrytningarna.
'Talet 64 refererar till en matris av rader som ligger omedelbart
'under automatiska sidbrytningar
ThisWorkbook.Names.Add Name:="Horisontella_Sidbrytningar", _
                                              RefersToR1C1:="=GET.DOCUMENT(64,""Blad1"")"
i = 1
While Not IsError(Evaluate("Index(Horisontella_Sidbrytningar," & i & ")"))
        ReDim Preserve hSidbrytningar(1 To i)
        hSidbrytningar(i) = Evaluate("Index(Horisontella_Sidbrytningar," & i & ")")
        i = i + 1
Wend
ReDim Preserve hSidbrytningar(1 To i - 1)

'Här loopas antalet sidbrytningar och data överförs från rad till kolumn
On Error Resume Next
For j = 1 To UBound(hSidbrytningar, 1)
     Set rnCell1 = Cells(hSidbrytningar(j), 1)
     Set rnCell2 = Cells(hSidbrytningar(j + 1), 1).Offset(-1, 0)
     'Kontroll av sista sidbrytningen
     If j + 1 > UBound(hSidbrytningar, 1) Then
        Range(rnCell1.Address, rnKolumn.Cells(65536, 1).End(xlUp)).Cut _
                 Destination:=Cells(1, j + 1)
      Else
        Range(rnCell1.Address, rnCell2.Address).Cut Destination:=Cells(1, j + 1)
      End If
Next j
On Error GoTo 0

Application.ScreenUpdating = True
End Sub