Function geeft een enorme vertraging

[Robert Smidt]

Beste Forumleden,

Onderstaande code gebruik ik om vanuit een planbordprogramma het verlof, ziekte enz. per medewerker te berekenen. Maar omdat er 64 regels en ruim 1000 kolommen zijn gevuld, wordt het systeem ontzettend traag. Wanneer ik onderstaande verwijder, dan is dat weer opgelost. Aangezien ik niet bij iedere mutatie hoef te weten wat het overzicht is, zou ik onderstaande graag uit willen schakelen. Dit heb ik deels opgelost met: If [B2] = False Then Exit Function, maar dan nog pakt het systeem een deel van de code. Is er ook een oplossing dat ik onderstaande code volledig uit en in kan schakelen op moment dat ik het overzicht wil bekijken?

Function MijnTijden(Naam As String, Maand As Integer, PrNaam As String, HoofdTabel As Range)
If [B2] = False Then Exit Function
On Error Resume Next
Dim RijNr As Integer, KolomNr As Integer, Temp, Rij, Temp2
If Naam = "" Then MijnTijden = "": Exit Function
Set Temp = HoofdTabel.Columns(1).Find(Naam, , , xlWhole)
If Temp Is Nothing Then
    'MsgBox (Naam & " niet gevonden")
    Exit Function
End If
RijNr = Temp.Row - HoofdTabel(1, 1).Row + 1
Rem  For KolomNr = 6 To HoofdTabel.Columns.Count Step 1
For KolomNr = 8 To HoofdTabel.Columns.Count Step 1
    Temp = HoofdTabel(1, KolomNr)
    If IsDate(Temp) Then
      If Month(Temp) = Maand Then
        For Rij = RijNr To RijNr + 2
          Temp2 = HoofdTabel(Rij, KolomNr)
          If Temp2 = PrNaam Then
              MijnTijden = MijnTijden + HoofdTabel(Rij, KolomNr + 1)
          End If
        Next
      End If
    End If
  Next
End Function

Alvast heel hartelijk dank.

Robert

 

[JEC.]

Bouw hem om tot een "sub" ipv een een functie, blijkbaar gebruik je het al als macro(eenmalig runnen en je weet genoeg)

 

[edmoor]

Maak er eens dit van:

Function MijnTijden(Naam As String, Maand As Integer, PrNaam As String, HoofdTabel As Range)
If [B2] = False Then Exit Function
On Error Resume Next
Dim RijNr As Integer, KolomNr As Integer, Temp, Rij, Temp2
If Naam = "" Then MijnTijden = "": Exit Function
Set Temp = HoofdTabel.Columns(1).Find(Naam, , , xlWhole)
If Temp Is Nothing Then
    'MsgBox (Naam & " niet gevonden")
    Exit Function
End If
RijNr = Temp.Row - HoofdTabel(1, 1).Row + 1
Rem  For KolomNr = 6 To HoofdTabel.Columns.Count Step 1

[COLOR="#FF0000"]cm = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False[/COLOR]

For KolomNr = 8 To HoofdTabel.Columns.Count Step 1
    Temp = HoofdTabel(1, KolomNr)
    If IsDate(Temp) Then
      If Month(Temp) = Maand Then
        For Rij = RijNr To RijNr + 2
          Temp2 = HoofdTabel(Rij, KolomNr)
          If Temp2 = PrNaam Then
              MijnTijden = MijnTijden + HoofdTabel(Rij, KolomNr + 1)
          End If
        Next
      End If
    End If
  Next
  
[COLOR="#FF0000"]Application.Calculation = cm
Application.ScreenUpdating = True[/COLOR]
End Function

 

[snb]

Werk niet in het werkblad, maar gebruik een array.
Verminder het aantal lees/schrijfakties tot 2.

 

[Robert Smidt]

Heel hartelijk dank voor het meedenken en het aanleveren van oplossingen. Helaas begrijp ik #4 niet wat er bedoeld wordt met: gebruik een array. Verminder het aantal lees/schrijfakties tot 2.

Als ik er een sub van maak, krijg ik de foutmelding: Compileerfout: Het argument is niet optioneel. If Naam = "" Then MijnTijden = "": Exit Sub. Het systeem loopt dan ook vast.

 

[JEC.]

Als je er een sub van maakt, moet je de code herschrijven. Het is niet alleen aanpassen van Function naar Sub

 

[Robert Smidt]

Graag zou ik daar wat hulp bij willen hebben omdat ik nog niet eerder met "Function" heb geprogrammeerd. Deze code kreeg ik onlangs en werkt prima binnen een klein gebied.