VBA: Records die voldoen aan dezelfde criteria, optellen

[RoCompy87]

Hallo iedereen,

Bij het bouwen van een bestandje voor mijn werk, loop ik tegen een probleem aan dat ik graag met behulp van VBA wil oplossen (omdat het onderdeel uitmaakt van een groter 'geautomatiseerd proces').

Ik haal iedere maand de financiële boekingen uit de administratie (zie bijlage). Dit bestand wil ik op een bepaalde manier omzetten, zodat ik er een rapportage uit krijg. Bij dit omzetten wil ik het bedrag van de boekingen voor eenzelfde periode, rekeningnummer en kostenplaats optellen tot één record. Als er in periode 10 bijvoorbeeld drie keer 500 euro is geboekt op rekening 4816 op kostenplaats T35, wil ik niet meer deze records zien, maar één record met een bedrag van 1500 euro.

Hoe kan ik dit het beste aanpakken?

Ik heb al gedacht aan het toepassen van autofilter in een loop waarbij record voor record wordt geanalyseerd en vervolgens de waarden worden opgeteld, maar bij veel boekingsregels kan dat proces nogal lang gaan duren.

Alvast bedankt voor de moeite :thumb:

 

[danny147]

Beste RoCompy87

Zie bestandje.

Hier een voorbeeld met een filter en zie uitkomst onderaan.
2de mogelijkheid rechts met SOMPRODUCT, kies de items en zie resultaat.
3de mogelijkheid is met een draaitabel maar heb ik niet gemaakt.

Groetjes Danny. :thumb:

 

[RoCompy87]

Danny,

Alvast bedankt voor je reactie, ik ga er morgen even naar kijken en dan laat ik nog van me horen!

 

[oeldere]

Beste Danny,

mooie oplossing.

zelf zou ik er wel voor kiezen om de subtotaalformule boven de reeks (E1) te vermelden.

dan blijft het gemakkelijker om data bij te voegen (onder de reeks).

de oplossing met validatie is ook mooi gevonden.

welke manier heb je gebruikt om de gegevens op blad 1 te vullen?

 

[danny147]

Bestev oeldere

Beste Danny,

mooie oplossing.

zelf zou ik er wel voor kiezen om de subtotaalformule boven de reeks (E1) te vermelden.

dan blijft het gemakkelijker om data bij te voegen (onder de reeks).

de oplossing met validatie is ook mooi gevonden.

welke manier heb je gebruikt om de gegevens op blad 1 te vullen?

Voor de gegevens op blad1 heb ik kolom A,C en D gekopieërd naar BLAD1 en dan in Excel 2007 gekozen voor duplikaten verwijderen.

Groetjes Danny. :thumb:

 

[cow18]

zo werkt het met een draaitabel en er onder staat de formule om de gegevens er weer uit te halen

 

[RoCompy87]

Ik ben eens aan de slag gegaan met de somproduct-formule. Maar ik ben er via wat googlen al achter gekomen dat somproduct in VBA niet gemakkelijk is. Onderstaande code resulteert dan ook in foutmeldingen (even afgezien van het feit dat de bereiken nog niet variabel zijn en al die finetuning ), maar het maakt misschien wel duidelijk wat ik wil.

Sub bewerken_export()
Dim r, s, t, per, rek As Long
Dim kpl As String
With Sheets(1)
    s = 1
    For t = 429 To 3 Step -1
        per = .Cells(t, 1)
        rek = .Cells(t, 3)
        kpl = .Cells(t, 4)
If Application.SumProduct((.Range("A3:A429") = per) * (.Range("C3:C429") = rek) * (.Range("D3:D429") = kpl) * (.Range("E3:E429"))) <> .Cells(t, 6) Then
            .Cells(t, 6) = Application.SumProduct((.Range("A3:A429") = per) * (.Range("C3:C429") = rek) * (.Range("D3:D429") = kpl) * (.Range("E3:E429")))
            Sheets(3).Rows(s) = .Rows(t)
            s = s + 1
            For r = 3 To 429
                If .Cells(r, 1) = per And .Cells(r, 3) = rek And .Cells(r, 4) = kpl Then .Rows(r).Delete
            Next r
            Else
                Sheets(3).Rows(s) = .Rows(t)
                s = s + 1
        End If
    Next t
End With
End Sub

Met behulp van de draaitabel alle 'unieke records' via VBA onder elkaar krijgen lijkt me ook best moeilijk. Heeft iemand een suggestie voor een goede aanpak?

 

[cow18]

zie bijlage, die unieke records uit de draaitabel worden in AA1 en volgende van draatiabel gezet.
let op; er zijn een aantal lijnen van je gegevens geschrapt om binnen de 100 kb te komen. Dus de cijfers zullen niet kloppen tov. de oorspronkelijke gegevens. De macro werkt wel.

 

[RoCompy87]

Wow, super! Hiermee moet het zeker lukken, dank je wel :thumb: