Excel VBA berekening totale omvang orders per dag in grafiek.

[Jackson1]

Hallo Allemaal,

Ik heb een Excel/vba gevalletje waar ik niet uit kom.

Ik heb een tabel met daarin diverse service orders bij klanten. Per service order heb ik de daarbij behorende omvang (euro), start tijd, eind tijd en het berekent aantal werkdagen van de voering.

De uitvoertijden van de diverse service orders overlappen elkaar. Wat ik probeer te realiseren is per dag de totale omzet te berekenen en deze in een grafiek weer te geven waarbij op de x-as de tijd wordt weergegeven (te beginnen met de laagste datum en eindigend met de hoogste datum) en op de y-as de som van de totale omzet per tijdseenheid (dag, week of maand).

Is er iemand die mij verder kan helpen?

------------------------------------

Jackson

 

[wampier]

Het meest eenvoudige is toch om de omzet per kalenderdag te nemen i.p.v. per werkdag, dat geeft je de meeste flexibiliteit in je code. Dit kan natuurlijk eventueel in een verborgen kolom

ik heb zelf een kolom toegevoegd in kolom "L" waar ik kolom "F" en "I" op elkaar deel (a de formule in kolom "K")

Vervolgens maak ik twee tabellen aan met de eurowaarde per interval. Helaas is dit nodig in Excel. indien je deze kolommen per se weer kwijt wilt moet je even een copy/paste-as-picture doen op de grafiek en de kolommen verwijderen in de macro.

Range heb ik er even hardcoded in gezet, je kunt dit middels een sub of een dynamische range eenvoudig aanpassen aan je wensen. De variabele "interval" is het aantal dagen tussen meetpunten vanaf de begindatum. Het was even puzzelen, maar de meeste code had ik min of meer ergens nog liggen.

    Application.Calculation = xlCalculationManual
    Dim rng As Range
    Set rng = Range("g14:h27")
    Dim beginD As Double 'begin datum
    Dim endD As Double 'eind datum
    Dim beginDI As Double 'begin datum per lijn
    Dim endDI As Double 'eind datum per lijn
    Dim interval As Integer 'dagen interval voor meetpunt
    Dim weektotaal() As Double 'totaal in geld per interval (week kan eigenlijk weg)
    Dim count As Integer 'aantal intevallen tussen begin en eind
    Dim subt As Long 'subtotaal per lijn
           
    interval = 30 'aantal dagen interval
   
    endD = rng.Cells(rng.Rows.Count, 2).Value2
    beginD = rng.Cells(rng.Rows.Count, 1).Value2
    count = WorksheetFunction.RoundUp((endD - beginD) / interval, 0)
    ReDim weektotaal(0 To count)
   
    For items = 1 To rng.Rows.Count - 1
        If rng.Cells(items, 1) <> "" Then
            beginDI = rng.Cells(items, 1).Value2
            endDI = rng.Cells(items, 2).Value2
                For iv = 1 To count
                    If (beginD + iv * interval) > beginDI Then
                        If (beginD + iv * interval) < endDI Then
                           
                            subt = (beginD + iv * interval) - beginDI
                            If subt > interval Then
                                subt = interval
                            End If
                            weektotaal((iv - 1)) = weektotaal((iv - 1)) + (subt * rng.Cells(items, 6))
                            'ActiveSheet.Cells(iv, 40 + items) = subt
                           
                        Else
                           
                            subt = interval + (endDI - (beginD + iv * interval))
                            If subt < 0 Then
                                subt = 0
                            End If
                            If ((beginD + (iv - 1) * interval) - beginDI) < 0 Then
                                subt = subt + ((beginD + (iv - 1) * interval) - beginDI)
                            End If
                            weektotaal((iv - 1)) = weektotaal((iv - 1)) + (subt * rng.Cells(items, 6))
                            'ActiveSheet.Cells(iv, 40 + items) = subt
                        End If
                    End If
                Next iv
        End If
    Next items
                       
    For iv = 1 To count
        ActiveSheet.Cells(iv, 39) = iv
        ActiveSheet.Cells(iv, 40) = weektotaal(iv - 1)
    Next iv
   
    Set myChart = ActiveSheet.ChartObjects.Add(Left:=50, Width:=400, Top:=400, Height:=250)
    With myChart.Chart
        .ChartType = xlXYScatterLines
       
        Do Until .SeriesCollection.count = 0
            .SeriesCollection(1).Delete
        Loop
        With .SeriesCollection.NewSeries
            .Values = Range(Cells(1, 40), Cells(count, 40))
            .XValues = Range(Cells(1, 39), Cells(count, 39))
            .Name = "test"
        End With
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate

 

[Jackson1]

Wampier,

Van harte bedankt voor de oplossing en de tijd die je erin gestoken hebt!!!!!

Dit is de code waar ik naar op zoek was (zelf was ik nooit tot die code gekomen).
Ik moet hem nog wel een kleinbeetje aanpassen en inbouwen in de origineele sheet maar nu ik de basis heb gaat helemaal goed komen.

Nogmaals:thumb:

----------------

Jackson

 

[wampier]

Geen probleem, heb ik wat anders te doen dan sudoku op het vliegveld

Eerlijkheidshalve moet ik misschien wel even melden dat voor jouw specifieke probleem de code eigenlijk onnodig complex is. In principe kun je altijd met interval '1' werken en dat maakt de code een stuk eenvoudiger.

Het origineel van deze code slaat ook de tussenwaarden per regel apart op en het gebruik van de interval code heeft als voordeel dat het een stuk beter loopt op een laptop met 1ghz processor en 512mb ram als je een groot bereik aan data hebt (ja het origineel is ZO oud)

 

[Jackson1]

Ik ben vanmorgen nog even bezig geweest om de code in het origineel te "bouwen".
Het is nog niet helemaal gelukt om de code te integreren in de originele sheet maar dat heeft meer te maken met de complexiteit (en grote) van de originele sheet.

Het duurde even voor ik de VB code werkend kreeg, maar principe heb ik in elk geval werkend, zodra ik wat meer tijd heb deze week moet dat goed komen.
Het voordeel is dat ik weer wat heb geleerd van VB

Het interval heb ik vanmorgen toevallig op 1 gezet

Wat ik alleen nog niet zo goed begrijp is waarom je de berekening op handmatig hebt gezet (Application.Calculation = xlCalculationManual), maar dat is volgens mij meer mijn gebrek aan VBA kennis;-)

Nogmaals bedankt, mocht ik er deze week niet uit komen kan het zijn dat ik iin dit Topic nog een vraag stellen mbt de code.

---------------------------

Jackson

 

[wampier]

Handmatige calculatie voorkomt dat excel bij elke nieuw geplaatste cel het hele sheet gaat controlleren.

Bij interval 1 betekend dat, in dit geval, 400 controles van het gehele sheet, terwijl er geen enkele verwijzing naar deze cellen is. je kunt de 'calculate' regels voor de gein eens op commentaar zetten en het resultaat na je koffiepauze bekijken

 

[Jackson1]

Handmatige calculatie voorkomt dat excel bij elke nieuw geplaatste cel het hele sheet gaat controlleren. QUOTE]
Weer wat geleerd

Bij het inbouwen van de code in de originele sheet loop ik toch nog tegen wat probleempjes aan. De code stopt of start eerder en de totale omzetten per dag kloppen niet (in het voorbeeld werkt het wel goed)
Waarschijnlijk is er meer nodig kan wat knip, plak en " code edit kennis"
Ook heb ik wel eens dat de code ineens niet meer werkt als ik de data heb aangepast..

Om het duidelijk te maken heb ik de originele sheet leeg gemaakt op het "probleemstuk na en heb ik een opzetje gemaakt wat ik met de sheet wil bereiken.

Ik hoop dat je er nog naar de code wil kijken die ik in de sheet heb proberen te bouwen.

---------------------------

Jackson

 

[wampier]

gevonden!

mijn fout

rng.row moet vervangen worden door rng.rows.count. hij ziet blijkbaar de range als meerdere areas, en houdt de formule dus te vroeg op (vanwege de lege tussen-regels). Met rng.rows.count gaat het wel goed

 

[Jackson1]

Wampier,

Het werkt

Nogmaals harstikke bedankt voor de tijd die je erin gestoken hebt, je hebt me echt verder geholpen.
De sheet heeft nu veel meer toegevoegde waarde!

Ik moet alles nog even op zijn plek zetten maar dat moet wel lukken.

Tanx:thumb:

-----------------

Jackson