22. februar 2018 - 15:53
Der er
4 kommentarer og
1 løsning
VBA kode til at flytte data fra kolonner til linjer
Jeg har i dag et ark med mange linjer, hvor der står noget i 8 kolonner.
Det er typiske en linje pr. dato., dog ikke altid.
Jeg vil meget gerne have lavet dette om til at stå på linjer i stedet i 4 kolonner.
Kan det mon lade sig gøre i VBA ?
Jeg har prøvet at illustrere nuværende og ønsket opstilling nedenfor.
Bemærk at de kontonumre / tekster der står i linje 2, skal anvendes til alle linjer ved konvertering.
NUVÆRENDE OPSTILLING
A B C D E F G H
Bilag Dato Tekst Konto 1 Konto 2 Konto 3 Konto 4 Konto
1000 1010 1020 5800 5820
1 01-01-2017 diverse -400 -500 -100 800 100
2 02-01-2017 altmuligt -1500 0 0 900 400
osv.
ØNSKET OPSTILLING
A B C D E
1 01-01-2017 1000 diverse -400
1 01-01-2017 1010 diverse -500
1 01-01-2017 1020 diverse -100
1 01-01-2017 5800 diverse 800
1 01-01-2017 5820 diverse 100
2 02-01-2017 1000 altmuligt -1500
2 02-01-2017 1010 altmuligt 0
2 02-01-2017 1020 altmuligt 0
2 02-01-2017 5800 altmuligt 900
2 02-01-2017 5820 altmuligt 400
23. februar 2018 - 01:09
#3
Hej mrkr
Jeg har forsøgt med en hurtig VBA-løsning uden fejlcheck. Den forudsætter, at kolonnerne A til H er som beskrevet i #1. For at makroen virker skal du markere cellen med det første bilagsnummer. Ingen tomme linjer i dine bilag. Kopier følgende kode til et tomt makromodul:
Option Base 1
Sub FlytData()
Dim MyArray()
Dim AntRk As Integer, i As Integer, j As Integer
If ActiveCell.Offset(1, 0).Value = "" Then
AntRk = 1
Else
AntRk = Range(ActiveCell, ActiveCell.End(xlDown)).Rows.Count
End If
ReDim MyArray(5, AntRk * 5)
i = 1
Do While ActiveCell.Value <> ""
For j = 1 To 5
MyArray(1, i) = ActiveCell.Value
MyArray(2, i) = ActiveCell.Offset(0, 1).Value
MyArray(3, i) = Cells(2, j + 3).Value
MyArray(4, i) = ActiveCell.Offset(0, 2).Value
MyArray(5, i) = ActiveCell.Offset(0, j + 2).Value
i = i + 1
Next
ActiveCell.Offset(1, 0).Select
Loop
ActiveWorkbook.Sheets.Add
With ActiveSheet
.Cells(1, 1) = "Bilag"
.Cells(1, 2) = "Dato"
.Cells(1, 3) = "Konto"
.Cells(1, 4) = "Tekst"
.Cells(1, 5) = "Beløb"
For i = 1 To AntRk * 5
For j = 1 To 5
.Cells(i + 1, j) = MyArray(j, i)
Next
Next
End With
End Sub
De transponerede data skrives i et nyt ark.
03. marts 2018 - 18:42
#4
For dælen da. Jeg fik slet ikke fulgt op på denne. Beklager mange gange :-(
xl-Enthusiast
Jeg har prøvet med løsningen med formler.
Jeg kan se at den virker lige efter hensigten, men jeg kan ikke finde ud af at få det til at virke når jeg indsætter flere linjer.
Tegler
Den kode du har lavet virker lige efter hensigten. også når jeg putter flere linjer på.
Mange tak for input og hjælpen til jer begge to :-)
