Avatar billede lineriber Praktikant
16. november 2015 - 08:46 Der er 7 kommentarer og
1 løsning

VBA converter matrix til tabel/liste format

Hej eksperter

jeg har brug for hjælp til at skrive og forstå en VBA kode som jeg jævnligt skal bruge i modificeret form.
Jeg modtager ofte data I excel I matrix format a la nedenstående:

Account    Name    Type    Jan    Feb    Mar    ...    Dec
601040    Tests    Cost    100    150    105    ...    254
601041    Office    Cost    200    250    255    ...    245
700001    Intern    Hour    105    115    175    ...    225



I dette tilfælde har jeg altså 3 kolonner med oplysninger + 12 kolonner med værdier(en kolonne per måned). Det vil jeg gerne have omdannet til en table/liste med kun en værdikolonne, som kan bruges som input til pivottabeller:

Account    Name    Type    Month    Value
601040    Tests    Cost    Jan    100
601040    Tests    Cost    Feb    150
601040    Tests    Cost    Mar    105
601040    Tests    Cost    ...   
601040    Tests    Cost    Dec    254
601041    Office    Cost    Jan    200
601041    Office    Cost    Feb    250

...
..

Jeg har fundet masser af VBA koder på nettet der kan konvertere en matrix til en 3 kolonners table, men jeg kan ikke finde ud af at omskrive dem, så de kan håndterer situationer hvor der er flere kolonner med oplysninger + 12 værdikolonner.

Det er meget forskelligt hvormange kolonner jeg har med oplysninger, fx det jeg arbejder med lige nu har 15 kolonner, så jeg skal altså bruge en kode der er dynamisk nok til at kunne håndtere dette + som jeg skal kunne forstå så meget, at jeg kan tilpasse den til behovet.

Håber meget på jeres ekspert hjælp.

mvh
Line
Avatar billede supertekst Ekspert
16. november 2015 - 13:47 #1
Dim antalRækker As Integer, antalKolonner As Integer, antalInfoKolonner As Integer
Dim ræk As Integer, ræk2 As Integer, kol As Integer
Public Sub klargørTilPivot()
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    antalKolonner = ActiveCell.SpecialCells(xlLastCell).Column
   
    antalInfoKolonner = antalKolonner - 12
   
Rem sæt overskrifter - 5 rækker efter sidste række af oprindelige rækker
    ræk2 = antalRækker + 5
    For kol = 1 To antalInfoKolonner
        Range("A" & ræk2).Offset(0, kol - 1) = Range("A1").Offset(0, kol - 1)
    Next kol
    Range("A" & ræk2).Offset(0, kol - 1) = "Month"
    Range("A" & ræk2).Offset(0, kol) = "Value"
    ræk2 = ræk2 + 1
   
Rem Opbygger
    For ræk = 2 To antalRækker
        Range(Cells(ræk, 1), Cells(ræk, antalInfoKolonner)).Copy
        Range("A" & ræk2).Select
        ActiveSheet.Paste
       
        For kol = antalInfoKolonner + 1 To antalKolonner
            Range("A" & ræk2).Select
            ActiveSheet.Paste
            Cells(ræk2, antalInfoKolonner + 1) = Cells(1, kol)
            Cells(ræk2, antalInfoKolonner + 2) = Cells(ræk, kol)
            ræk2 = ræk2 + 1
        Next kol
        Application.CutCopyMode = False
    Next ræk
End Sub
Avatar billede lineriber Praktikant
16. november 2015 - 14:33 #2
Fantastisk som altid Supertekst. Tak for hjælpen. smider du et svar?
Avatar billede supertekst Ekspert
16. november 2015 - 15:11 #3
Et svar og tak for ...  og selv tak
Avatar billede lineriber Praktikant
17. november 2015 - 07:25 #4
øv! Koden virkede fint på min lille test på 10 rækker. Men performance er ikke god på min totale matrix på 10.000 rækker.....
Supertekst kan du gøre noget? Skal jeg oprette et nyt spørgsmål, for jeg har jo ikke fået beskrevet omfanget godt nok I dette spørgsmål!
Avatar billede supertekst Ekspert
17. november 2015 - 08:51 #5
Ok - prøver at se på den nuværende løsning - ikke nødvendigt med nyt spørgsmål
Avatar billede supertekst Ekspert
17. november 2015 - 10:43 #6
Har testet med 10.000 rækker - ca. 1 minut

Rem Version 2
Dim antalRækker As Integer, antalKolonner As Integer, antalInfoKolonner As Integer
Dim ræk As Long, ræk2 As Long, kol As Integer, kol2 As Integer
Public Sub klargørTilPivot()
    Application.ScreenUpdating = False
   
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    antalKolonner = ActiveCell.SpecialCells(xlLastCell).Column
   
    antalInfoKolonner = antalKolonner - 12
   
Rem sæt overskrifter - 5 rækker efter sidste række af oprindelige rækker
    ræk2 = antalRækker + 5
    For kol = 1 To antalInfoKolonner
        Range("A" & ræk2).Offset(0, kol - 1) = Range("A1").Offset(0, kol - 1)
    Next kol
    Range("A" & ræk2).Offset(0, kol - 1) = "Month"
    Range("A" & ræk2).Offset(0, kol) = "Value"
    ræk2 = ræk2 + 1
    kol2 = antalInfoKolonner + 1
   
Rem Opbygger
    For ræk = 2 To antalRækker
        For kol = 1 To antalKolonner
            If kol <= antalInfoKolonner Then
                Range("A" & ræk2).Offset(0, kol - 1) = Range("A" & ræk).Offset(0, kol - 1)
            Else
                Cells(ræk2, antalInfoKolonner + 1) = Cells(1, kol2)
                Cells(ræk2, antalInfoKolonner + 2) = Cells(ræk, kol2)
                ræk2 = ræk2 + 1
                kol2 = kol2 + 1
                kol = 0
            End If
            If kol2 > antalKolonner Then
                Exit For
            End If
        Next kol
        kol2 = antalInfoKolonner + 1
    Next ræk
End Sub
Avatar billede lineriber Praktikant
19. november 2015 - 09:28 #7
Perfekt, tak Supertekst :-)
Avatar billede supertekst Ekspert
19. november 2015 - 09:50 #8
Selv tak..
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester