Opgelost Tabel omzetten in database in excel

[Peeeeekaaaa]

Ik wil graag gegevens in een tabel omzetten in een database format. ZIe voorbeeld in bijlage. Vraag hoe kan ik de gegevens op iedere rij onder elkaar in de database krijgen waarbij de naam van iedere regel netzoveel keer herhaald dient te worden als het betreffende aantal kolommen waar gegevens staan.

Alvast dank je wel voor je hulp

 

[JEC.]

Hier een optie met Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Tabel2"]}[Content],
    colNames = Table.ColumnNames(Source),
    grp = Table.Group(Source, {"I"},
      {{"Count", each
             let
                t1 = Table.ToRows(Table.SelectColumns(_,List.FirstN(List.Skip(colNames,3),9))),
                t2 = Table.ToRows(Table.SelectColumns(_,List.LastN(colNames,9)))
             in             
                Table.FromColumns(t1 & t2)
       }}     
     ),
    expand = Table.ExpandTableColumn(grp, "Count", {"Column1", "Column2"}, {"Datum", "Num"}),
    result = Table.TransformColumnTypes(expand,{{"Datum", type date}, {"Num", Int64.Type}})
in
    result

 

[AHulpje]

Of met een macro, zie bijlage.

Sub Converteer()
    With Sheets("Database")
        For r = 2 To 11
            For k = 1 To 9
                .Cells((r - 2) * 9 + k, 1) = Sheets("Bron").Cells(r, 1)
                .Cells((r - 2) * 9 + k, 2) = Sheets("Bron").Cells(r, k + 3)
                .Cells((r - 2) * 9 + k, 3) = Sheets("Bron").Cells(r, k + 12)
            Next
        Next
        Range(Range("B1"), Range("B1").End(xlDown)).NumberFormat = "m/d/yyyy"
    End With
End Sub

 

[Peeeeekaaaa]

Ik heb beide opties bekeken, dank hiervoor. Ik ga verder met de powerquery. Bedankt voor jullie hulp!

 

[snb]

@AHulpje

Zie https://www.snb-vba.eu/VBA_Arrays.html

Sub M_snb()
   sn = Sheet3.Cells(1).CurrentRegion
   ReDim sp(9 * UBound(sn), 2)
  
   For j = 2 To UBound(sn)
     For jj = 4 To 12
       sp(n, 0) = sn(j, 1)
       sp(n, 1) = sn(j, jj)
       sp(n, 2) = sn(j, jj + 9)
       n = n + 1
     Next
   Next
  
   Cells(20, 1).Resize(UBound(sp), UBound(sp, 2) + 1) = sp
End Sub