Weken tellen met voorwaardes

[halloikke]

Geachte lezers,

Ik zit met het volgende probleem:

Ik heb een bestand waarin van een groot aantal personen te zien is in welke weken ze wel en niet gewerkt hebben.
Nu zou ik graag een telling hebben van het aantal gewerkte weken van iedere persoon. Echter als een persoon 26 weken of meer niet gewerkt heeft, moet de telling weer op 0 beginnen. Tevens wil ik graag zien in welke week dit voor het laatst van toepassing is geweest.

Ik heb een klein test bestandje gemaakt waarmee gewerkt kan worden. Hierbij heb ik slechts enkele gegevens gevuld.

Kan iemand mij hierbij helpen?

Bekijk bijlage test - Copy - Copy (2).xlsx

 

[mvw64]

Misschien kan je hier iets mee ?

 

[halloikke]

Beste mvw64,

Alvast heel erg bedankt voor wat je gemaakt hebt. Dit doet inderdaad precies wat het moet doen.
Echter heb ik nog wat aanvullende wensen erbij gekregen. Ik hoop dat dit ook nog te verwerken is.

Ik heb een aantal verschillende jaren waarvan ik de gegevens heb. Nu wil ik graag van deze jaren over het totaal de telling hebben. Hierbij moeten de personen die in 2013 gewerkt hebben dus doorgeteld worden met de personen in 2014 en etc.

Verder wordt er voor het huidige jaar een telling toegevoegd tot een bepaalde week (nu bijvoorbeeld week 9). kan de macro automatisch stoppen bij het laatst bekende weeknummer?

 

[halloikke]

Hierbij nog het laatste bestand waarmee gewerkt kan worden.

Bekijk bijlage Map12.xlsx

 

[VenA]

Volgens mij zit er geen macro in jouw bestand. De jaren samenvoegen kan je eenvoudig realiseren met vert.zoeken.

 

[mvw64]

Kijk eens of je hier iets mee kan

 

[halloikke]

Ik heb het beste van jullie samengevoegd. Hij doet nu ongeveer wat ik wil, echter duurt de uitvoering van de macro nu zeeer lang en zorgt deze ervoor dat de pc uiteindelijk vastloopt. soms geeft de macro foutcode 400.

Doe ik iets verkeerd of zijn mijn gegevens te groot geworden.



Om op de vragen van mvw64 terug te komen:
2013-01 betekend week 1 van 2013. daar wilde ik dus alle gegevens op 1 werkblad weergeven. Dit is gelukt met de formule van VenA.

het laten stoppen is geen noodzaak, maar zou wel handig zijn, dan hoef ik niet iedere keer het nummer in de macro (nu 177) aan te passen naar het werkelijke aantal kollommen als 2016 toeneemt.
De 0 wordt inderdaad niet meegeteld, maar als er na de laatste gevulde week nog 26 weken zouden staan, dan wordt het aantal gewerkte weken ook weer 0. Hier wilde ik op deze manier voor waken.

 

[halloikke]

wederom al het goede in 2e, en ben ik de bijlage vergeten.

Bekijk bijlage Map12 (2).xlsb

 

[halloikke]

Ik heb inmiddels uitgevonden hoe ik er voor zorg dat de macro wel gaat lopen zonder vast te blijven hangen. (formules veranderen in harde waarden)

Nu heb ik echter nog 1 dingetje wat ik graag aangepast zou zien:

Ik krijg nu de eerste week te zien waarin een persoon gewerkt heeft. Ik zou hier graag de laatste week zien waarin iemand gewerkt heeft.

Ik heb nu de volgende macro:

Sub xxx()
    Range("A2:B600").ClearContents

    Range("D2").Select
Start:
    i = 0 'aantal keer gewerkt
    x = 0 'aantal weken niet gewerkt

Overnieuw:
    If ActiveCell <> Empty Then i = i + 1: x = 0 'Teller plus 1
    If i = 1 And Cells(ActiveCell.Row, "A") = Empty Then Cells(ActiveCell.Row, "A") = Cells(1, ActiveCell.Column) 'Vanaf de active kolom naar boven naar de eerste regel
    Application.ScreenUpdating = False
    If ActiveCell = Empty Then x = x + 1 'Teller plus 1
    ActiveCell.Offset(0, 1).Select
    If x >= 26 Then i = 0:
    If ActiveCell.Column >= 169 Then GoTo Stoppen
GoTo Overnieuw

Stoppen:
    Cells(ActiveCell.Row, "B") = i
    Cells(ActiveCell.Row + 1, "D").Select
    If Cells(ActiveCell.Row, "C") = "" Then Exit Sub
    Application.ScreenUpdating = True
GoTo Start
End Sub

 

[VenA]

Bij grote bestanden met veel formules kan je beter de berekening op handmatig zetten. Ook werkt het sneller als je het geheel in een array zet en dus het meeste in het geheugen laat gebeuren.

Ik kom tot zoiets. Er staan voor mij teveel gegevens in het bestand op de uitkomst te controleren dus dat mag je zelf doen en eventuele aanpassingen laat ik ook aan je over.

Sub VenA()
Application.Calculation = xlManual
week = Year(Date) & "-" & Format(DatePart("ww", Date - Weekday(Date, 2) + 4, 2, 2), "00")
With Sheets("Totaal")
    ar = .Cells(1).CurrentRegion.Resize(, Application.Match(week, Sheets("Totaal").Rows(1), 0))
    ReDim ar1(UBound(ar), 2)
    For j = 2 To UBound(ar)
        Start = False
        For jj = 5 To UBound(ar, 2)
            If ar(j, jj) <> 0 Then
                If Not Start Then
                    ar1(j - 2, 0) = ar(1, jj)
                    Start = True
                    ar1(j - 2, 2) = ar1(j - 2, 0)
                    ar1(j - 2, 1) = 1
                  Else
                    If ar(j, jj) = 0 Then
                        ar1(j - 2, 2) = ar1(j - 2, 2)
                        t = t + 1
                      Else
                        ar1(j - 2, 2) = ar(1, jj)
                        If t < 26 Then ar1(j - 2, 1) = ar1(j - 2, 1) + 1 Else ar1(j - 2, 1) = 0
                    End If
               End If
            End If
        Next jj
    Next j
.[A2].Resize(UBound(ar1), UBound(ar1, 2) + 1) = ar1
End With
Application.Calculation = xlAutomatic
End Sub

 

[halloikke]

Beste VenA,

Helaas werkt het niet helemaal zoals het hoort. de getelde weken komen niet overeen met wat het zou moeten zijn.
Ik kan dit zelf ook niet oplossen omdat ik nooit eerder met een array gewerkt heb. Voor mij is het dus redelijk lastig te begrijpen wat er nu gebeurt en waar het mis gaat.

Is het mogelijk om de formules te vervangen door waarden (dit is een kleine moeite en heb ik er wel iedere keer voor over als het goed werkt), en dan de kolom te vullen op basis van een macro die lijkt op de macro die ik hiervoor genoemd heb? deze kan ik namelijk wel begrijpen en aanpassen als ik hem zie.

 

[VenA]

Geef in het bestand even aan wat de uitkomst moet zijn. De begin- en eindweek klopt wel?

 

[halloikke]

Hierbij het nieuwe bestand met daarbij voor de eerste regels aangegeven wat de uitkomsten zouden moeten worden.

Uit jouw reactie maak ik op dat je het bestand aan wilt passen met de array erin? Dit omdat er in de loop van 2016 nieuwe personen en weken toegevoegd gaan worden aan het bestand. Dan zal ik ook moeten snappen wat ik aan moet passen neem ik aan?
Bekijk bijlage halloikke (2).xlsb

 

[VenA]

Volgens mij klopt jouw voorbeeld niet. Bij werknemer a8 geef jij aan dat het 79 moet zijn. Volgens mij moet dit 32 zijn. Bij medewerker a13 geef je 0 aan volgens mij moet het 36 zijn. En moet er geteld worden van in dit geval week 9-2016 of vanaf de laatste gewerkte week?

 

[halloikke]

Er moet in dit voorbeeld geteld worden tot 2016-17. dat de laatste weken leeg zijn is even niet relevant. (wel voor a13, want daardoor wordt de einduitkomst 0, omdat er dan meer als 26 weken niet gewerkt is)

bij a8 zie ik dat ik inderdaad een periode van 26 aaneengesloten niet gewerkte weken over het hoofd heb gezien. Dit zou moeten worden: Vanaf 2015-12 in totaal 32 gewerkte weken.

 

[VenA]

Test deze eens

 

[halloikke]

Heel erg bedankt. Hij lijkt nu inderdaad precies te werken zoals ik het voor ogen had.
Nog een laatste kleine vraag. Kan ik gewoon personen en weken toevoegen aan het bestand en blijft alles dan werken?

 

[VenA]

Je kan weken en personen toevoegen zolang je maar geen lege rijen of kolommen gebruikt. ar = .Cells(1).CurrentRegion zorgt ervoor dat alle aaneengesloten cellen vanaf A1 in de array ingelezen worden.

De code heb ik een beetje herschreven omdat de extra lus alleen even was om te zien of resultaat nu wel klopt.

Sub VenA()
Application.Calculation = xlManual
With Sheets("Totaal")
    ar = .Cells(1).CurrentRegion
    ReDim ar1(UBound(ar), 2)
    For j = 2 To UBound(ar)
        b1 = False: b2 = False: t = 0
        ar1(j - 2, 1) = 0
        For jj = UBound(ar, 2) To 5 Step -1
            If ar(j, jj) = 0 And Not b2 Then
                t = t + 1
              Else
                If Not b1 Then ar1(j - 2, 2) = ar(1, jj)
                b1 = True
                ar1(j - 2, 0) = ar(1, jj)
                If t < 26 And Not b2 Then
                    ar1(j - 2, 1) = ar1(j - 2, 1) + 1
                    ar1(j - 2, 0) = ar(1, jj)
                    t = 0
                  Else
                    b2 = True
                    If ar(j, jj) <> 0 Then ar1(j - 2, 0) = ar(1, jj)
                End If
            End If
        Next jj
   Next j
.[A2].Resize(UBound(ar1), UBound(ar1, 2) + 1) = ar1
End With
Application.Calculation = xlAutomatic
End Sub

Een tip om te volgen wat een bepaalde code doet:
Zet in de VB editor het venster lokale variabelen aan en wandel vervolgens met <F8> of <Ctrl> + <F8> door de code.

 

[halloikke]

Top! Heel erg bedankt!