Samenvatting kosten met VBA code

[Evelyne78]

Hey,

Ik zou graag een samenvatting hebben van mijn kosten op basis van vba code (niet met formules). Omdat er altijd mensen zijn die erin slagen om er iets aan te veranderen.
In bijlage vinden jullie het bestandje. In het eerste tabblad wordt altijd een download gedaan van het rekeningplan. In het tweede tabblad heb je dan een download van de kosten met de bedragen. In het derde tabblad zou de code dan de som moeten maken van de verschillende kosten rekeningen. Dit zou in VBA kunnen heb ik horen zeggen met een teller in de code.
Ik heb in het "download rek" enkele kostenrekeningen in het rood gezet. Hiermee bedoel ik dat ze in het tabblad Lijst niet voorkomen, omdat er maanden kunnnen zijn dat die kosten niet gemaakt worden. Dan moet de code in het tabblad samenvatting gewoon verder gaan en niet blokkeren omdat hij de rekening die hij overloopt in het tabblad "download rek" niet vind (ik bedoel als dit nodig is, het kan zijn dat jullie iets schrijven waarbij de code enkel de rekeningen in het tabblad lijst overloopt en in het tabbald "samenvatting" de som zet. Maar stel dat er in het tabblad "samenvatting" een rekening ontbreekt die wel in "lijst" voorkomt. Dan zou het gemakkelijk zijn dat in het tabblad "nieuwe rekening" de rekeningen worden weergegeven die wel in het tabblad lijst voorkomen maar niet in het tabblad "samenvatting". Ik heb ze in het tabblad lijst in het blauw gezet.
Hopelijk heb ik het duidelijk verwoord.

Groetjes, Evelyne.

 

[Demeter]

Probeer deze code eens:

Sub zoek_rekening()
Dim b As Range
Dim laatsteregel1, laatsteregel2, legeregel, teller As Long

Application.ScreenUpdating = False

teller = 0
laatsteregel1 = Sheets("Lijst").Range("A65536").End(xlUp).Row

    For Each b In Sheets("Lijst").Range("A2:A" & laatsteregel1)
        If b <> "" Then
            laatsteregel2 = Sheets("Samenvatting").Range("A65536").End(xlUp).Row
            With Sheets("Samenvatting").Range("A4:A" & laatsteregel2)
            Set c = .Find(b.Value, LookIn:=xlValues)
                If c Is Nothing Then
                    legeregel = Sheets("Nieuwe rekeningen").Range("A65536").End(xlUp).Row + 1
                    Range("A" & b.Row).Copy Sheets("Nieuwe rekeningen").Range("A" & legeregel)
                    teller = teller + 1
                End If
            End With
        End If
    Next

MsgBox "Er zijn " & teller & " nieuwe rekeningen aangetroffen!"

Sheets("Nieuwe rekeningen").Activate

Application.ScreenUpdating = True
    
End Sub

Weet niet of hij al aan al je eisen voldoet maar we komen in de richting.
Denk dat je er zelf wel uit zal komen .

ps,
Waarom niet je blad beveiligen? formules onzichtbaar maken, password erop, etc......
Weet namelijk niet je VBA kennis nivo (en die van je collega's)!!!1

 

[Wigi]

Ferenc, als de structuur van het bestand goed is, is zoiets denk ik beter met een Autofilter te doen. Deze link kende je al, maar geef hem toch nog maar eens.

Wigi

 

[Demeter]

Wigi,

Heb met de autofilter opties zitten spelen maar zie niet in hoe ik dit probleem op deze manier kan oplossen!!

 

[Evelyne78]

Hey,

Bedankt voor de code. Ze zegt dat er 2 nieuwe rekeningen zijn en geeft deze ook weer in het werkblad '"Nieuwe rekeningen". Tot daar loopt het reeds perfect.
Maar in het tabblad "samenvatting" staat de som van de bedragen van de betreffende rekening er nog niet naast. In het tabblad "samenvatting" zou bijvoorbeeld naast rekening 610100 de som moeten komen van alle 610100 rekeningen uit het tabblad "lijst" en dit is 785 EUR. Als hij dit nog kan is de code helemaal inorde.

In ieder geval reeds bedankt voor de gescheven code.

Groetjes, Evelyne

 

[Demeter]

Oeps, deze is er even tussen door geglipt, misschien heb je al een antwoord gevonden maar hier toch een reactie:

Kijk eens naar de functie: Som.Als
Zet deze in B4 op blad Samenvatting en probeer deze werkende te krijgen.
Klopt dit zet hem dan door naar beneden.

Succes.

 

[Evelyne78]

Beste,

Ik heb de code met SomAls opgenomen. Deze zit nu in een module, maar hoe krijg ik
deze verwerkt in de andere code (die in het werkblad lijst staat) zodanig dat alles in 1
keer automatisch verloopt?

Groetjes, Evelyne

 

[Evelyne78]

Beste,

Iemand een ideetje om de code verder aan te vullen?

Groetjes, Evelyne

 

[Demeter]

Beetje hulp van de bekende zoekmachines op de zoekwoorden: excel vba en sumif en de al gegeven code:

Sub zoek_rekening()
Dim b, d As Range
Dim laatsteregel1, laatsteregel2, legeregel, teller As Long
Dim c

Application.ScreenUpdating = False

teller = 0
laatsteregel1 = Sheets("Lijst").Range("A65536").End(xlUp).Row

    For Each b In Sheets("Lijst").Range("A2:A" & laatsteregel1)
        If b <> "" Then
            laatsteregel2 = Sheets("Samenvatting").Range("A65536").End(xlUp).Row
            With Sheets("Samenvatting").Range("A4:A" & laatsteregel2)
            Set c = .Find(b.Value, LookIn:=xlValues)
                If c Is Nothing Then
                    legeregel = Sheets("Nieuwe rekeningen").Range("A65536").End(xlUp).Row + 1
                    Range("A" & b.Row).Copy Sheets("Nieuwe rekeningen").Range("A" & legeregel)
                    teller = teller + 1
                End If
            End With
        End If
    Next
    
    For Each d In Sheets("Samenvatting").Range("A4:A15")
        If d <> "" Then
            d.Offset(, 1) = Application.WorksheetFunction.SumIf(Sheets("Lijst").Range("A2:A" & laatsteregel1), Sheets("Samenvatting").Range(d.Address), Sheets("Lijst").Range("B2:B" & laatsteregel1))
        End If
    Next

MsgBox "Er zijn " & teller & " nieuwe rekeningen aangetroffen!"

Sheets("Nieuwe rekeningen").Activate

Application.ScreenUpdating = True
    
End Sub

 

[Evelyne78]

Demeter,

Bedankt, het werkt perfect. Dit maakt mijn dag goed.
Dit is een mega goeie site!

Bedankt Dementer dat je dit hebt kunnen oplossen!! :thumb:

Nog een fijne dag toegewenst.

Groetjes, Evelyne

 

[Demeter]

Graag gedaan daar voor zijn we hierop het forum, om een ieder te helpen .

Bekijk vooral de functie:Application.WorksheetFunction
deze is wel handig om formules in een cel te zetten mbv vba.

 

[Evelyne78]

Hey,

Zal ik zeker onthouden.

Groeten, Evelyne