tabel omzetten

[ronsom]

Hallo allemaal,

In de bijlage een bestand met daarin 2 tabellen. Ik zou graag willen dat tabel2 omgezet wordt naar het format van tabel3.Ik wil graag het aantal unieke nummers weten per datum/handeling en naam.
Wie kan en wil mij daarbij helpen?

Vriendelijke groet Ronsom

 

[OctaFish]

Bij dit soort vragen breekt bij mij altijd een beetje het angstzweet uit, omdat ik vermoed dat je voorbeeldje niet echt representatief gaat zijn voor je feitelijke vraag: het zal geheid niet om twee records gaan, en de vraag is of je kolom nummer wel een goed voorbeeld bevat. Nu zijn er bijvoorbeeld verschillende aantallen getallen in kolom K te vinden (daar zit uiteraard het probleem) maar is die "spatie punt" combinatie op het eind standaard? En zijn de lege kolommen ook altijd leeg?
Je kunt hier geen simpele truc op loslaten, maar je zult een macro moeten hebben die ten eerste de datums omzet, en ten tweede op basis van de cellen in kolom K bepaalt hoeveel records er moeten worden aangemaakt. Dat kan nog wel redelijk simpel worden bepaald (K2 met Split in een array zetten op basis van een spatie, zodat je weet hoeveel rijen er moeten worden aangemaakt, en die aanmaken met de array waarden).
Vraag is natuurlijk: kun je dat zelf?

 

[OctaFish]

Zo niet: probeer deze macro eens uit; die doet het bij mij in ieder geval prima.

Sub OmzettenData()
Dim arr As Variant, num As Variant
Dim i As Integer, j As Integer, r As Integer
    arr = Cells(1).CurrentRegion
    Cells(1, 13) = arr(1, 1)
    Cells(1, 14) = arr(1, 5)
    Cells(1, 15) = arr(1, 6)
    Cells(1, 16) = arr(1, 11)
    r = 1
    For i = LBound(arr) + 1 To UBound(arr)
        num = Split(Replace(Trim(arr(i, 11)), " .", ""), " ")
        For j = LBound(num) To UBound(num)
            r = r + 1
            Cells(r, 13) = Format(arr(i, 1), "dd-mm-yyyy")
            Cells(r, 14) = arr(i, 5)
            Cells(r, 15) = arr(i, 6)
            Cells(r, 16) = num(j)
        Next j
    Next i
End Sub

 

[HSV]

Iets anders, ook het resultaat vergeleken met @Octafish.

Sub hsv()
Dim sv, sq, i As Long, j As Long, n As Long, s0 As String
ReDim arr(3, 0)
sv = Me.ListObjects("tabel2").Range
 For i = 1 To UBound(sv)
   sq = Split(Trim(sv(i, 11)))
  For j = 0 To UBound(sq)
   
    If InStr(s0, "|" & sq(j) & "|") = 0 And sq(j) <> "." Then
     arr(0, n) = sv(i, 1)
     arr(1, n) = sv(i, 5)
     arr(2, n) = sv(i, 6)
     arr(3, n) = sq(j)
            s0 = s0 & sq(j) &"|"
             n = n + 1
     ReDim Preserve arr(3, n)
    End If
  Next j
  s0 = ""
 Next i
   Columns(18).Resize(, 4).Clear
   Cells(1, 18).Resize(n, 4) = Application.Transpose(arr)
   ListObjects.Add(xlSrcRange, Cells(1, 18).CurrentRegion, , xlYes).Name = "tabelhsv"
 With ListObjects("tabelhsv")
   .Range.Sort .Range(1, 1), 2, .Range(1, 4), , 1, , , 1
 End With
End Sub

Ps. De code plaatsten in moduleblad van toepassing.

 

[ronsom]

Hallo HSV en Octafish,

volgens mij kan ik hier prima mee uit de voeten. ik test het morgen verder.

 

[ronsom]

Hallo,

In de bijlage heb ik de codes toegevoegd. Ook heb ik een draaitabel gemaakt met het beoogde resultaat. Ik denk dat dit de goede manier is om hier te komen.
Misschien hebben jullie nog aanvullingen hierop, dan hoor ik het graag.
Voor nu in ieder geval hartelijke dank!!

 

[HSV]

In mijn code moet je nog een kleine aanpassing doen.

s0 = s0 [COLOR=#ff0000]& "|"[/COLOR] & sq(j) & "|"

 

[ronsom]

Top!!
Dank je wel!!