Rest berekenen in verdeeltool

[VBA1]

Hallo allemaal, daar ben ik weer. Ik heb een tool geschreven waarin het aantal binnengekomen aanvragen per persoon wordt berekend aan de hand van arbeids patroon en werkpercentage en totale bezettingsuren. De routine waarin de rest wordt berekend moet lopen totdat de rest nul is. Maar dat doet ie niet, hij blijft hangen op 44 en dan is het een oneindige lus.

Ik plak hieronder code in te verduidelijking. Helaas kan ik het excel bestand niet uploaden, dat is te groot en het binaire bestand geeft een foutmelding, het bestand is in te zien op aanvraag, dan mail ik het naar je mocht het nodig zijn. Ik hoop dat een blik in onderstaande code genoeg is, wat doe ik fout? Alvast heel erg bedankt voor de hulp of tips.

Public Sub DeFormule()

      Dim GemiddeldAantal As Long
      Dim Uitkomst As Long
      Dim DagUren As Long
      Dim WeekUren As Long
      Dim Claim1 As Variant
      Dim Claim2 As Variant
      Dim BelastbaarheidsFactor As Long
      Dim SomBelastbaarheidsFactoren As Long
      Dim Row As Long
      Dim Wat As String
      Dim NogWat As String
      Dim teller As Integer
      Dim Rest, hetaantal As Long
      
      Let aantalcellen4 = Blad4.Range("A65500").End(xlUp).Row
      If CLng(frmVerdeel.txtAantal.Text) < aantalcellen4 Then
         MsgBox "Aantal is kleiner dan aantal medewerkers, graag handmatig verdelen..."
         Blad4.Activate
         Leeg
         Exit Sub
      End If
      Let GemiddeldAantal = CLng((frmVerdeel.txtAantal.Text) / aantalcellen4)
      Let hetaantal = CLng(frmVerdeel.txtAantal.Text)
'      Let Honderdprocent = 100 + 8 + 38

      Let Rij4 = 4
      For Rij4 = 4 To aantalcellen4
         Let Claim1 = Blad4.Cells(Rij4, 6).FormulaR1C1
         Let Claim2 = Claim1
'         If Claim2 > 5 Then Claim2 = 5
         Let DagUren = Blad4.Cells(Rij4, 4).Value
         Let BelastbaarheidsFactor = DagUren * Claim2
         Let sombelastbaarheidsfactor = sombelastbaarheidsfactor + BelastbaarheidsFactor
'         Let Rij4 = Rij4 + 1
      Next Rij4
      
      Let Rest = hetaantal - Val(WorksheetFunction.Sum(Blad4.Range("G4:G600")))
'      Let teller = 1
      Do While Rest > 0
              Let Rest = hetaantal - Val(WorksheetFunction.Sum(Blad4.Range("G4:G600")))
              Let Rij4 = 4
              Do While Rij4 <= aantalcellen4
        '         If Not sombelastbaarheidsfactor = 0 Then
                     Let Claim1 = Val(Blad4.Cells(Rij4, 6).FormulaR1C1)
                     Let Claim2 = Claim1
        '             If Claim2 > 5 Then Claim2 = 5
                     Let DagUren = Blad4.Cells(Rij4, 4).Value
                     Let BelastbaarheidsFactor = DagUren * Claim2
                     Let Uitkomst = CLng((BelastbaarheidsFactor / sombelastbaarheidsfactor) * Rest)
                     Let Blad4.Cells(Rij4, 7).Value = Blad4.Cells(Rij4, 7).Value + Uitkomst
        '              Blad3.Activate
        '              Let Wat = CStr(Blad4.Cells(Rij4, 3).Value)
        '              If Not Blad4.Cells(Rij4, 7).Value = 0 Then
        '                  Blad3.Cells.Find(What:=Wat, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        '                      :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        '                      False, SearchFormat:=False).Activate
        '                  Let Row = Cells.Row
        '                  Let ActiveCell(Row, 3).Value = ActiveCell(Row, 3).Value + Blad4.Cells(Rij4, 4).Value
        '                  Let ActiveCell(Row, 5).Value = ActiveCell(Row, 5).Value + Round(Uitkomst)
        '        '          Let ActiveCell(Row, 3).Value = Blad4.Cells(Rij4, 4).Value
        '              End If
                      If Blad4.Cells(Rij4, 7).Value = 0 Then Blad4.Cells(Rij4, 7).Delete
                      Let Rij4 = Rij4 + 1
        '              Let teller = teller + 1
        '          End If
              Loop
      Loop
      
      
     
     Blad4.Activate
     MaakBladAf
     Mailen

 

[wampier]

Zonder eigen simulatie is dit moeilijk te zien. Heb je al breakpoints gezet om te testen of het programma in de eerste of tweede while blijft hangen?

Mogelijk is het de binnenste while, omdat je rijen verwijderd en daarom "rij4" nooit groter wordt dan "aantalcellen4"?

 

[VBA1]

Ik heb inderdaad met breakpoints getest, Rij4 wordt gewoon groter dan aantalcellen4, dat is het niet.

 

[wampier]

En welke loop blijft de het programma hangen dan? De buitenste? of de x-de iteratie van de binnenste loop?

 

[VBA1]

De x-itteratie van de binnenste loop...

 

[wampier]

Dat is wel vreemd, tenzij rest dus niet meer verminderd. zet eens een watch op "rest" en de waarde daarvan per iteratie. Rest is een "long" en wordt dus afgerond op hele getallen. Blijft rest niet steken op "1" oid?

 

[VBA1]

Ligt aan het getal, de rest blijft soms ook steken op 44. Wat is probeer te doen is als volgt: Er worden bijvoorbeeld 250 aanvragen verdeeld over 80 mensen, maar niet gelijk, sommigen krijgen honderd procent anderen iets minder aan de hand van claim persentage, totale bezetting en daguren (= in de code te zien). Na de eerste verdeling bijft er dus een rest over, bijvoorveeld 40 of 100 of 51. Die rest wil ik dan weer over die 80 mensen verdelen volgens dezelfde formule, en dit net zo lang herhalen totdat de rest nul is of niet meer verdeeld kan worden. Help?