code sneller laten lopen

[deschrik]

Ik heb een code in VBA gemaakt die wordt gestart bij het activeren van een bepaald werkblad. Echter duurt het best lang voordat alles in dat werkblad is berekend. Weet iemand misschien hoe ik onderstaande code korter kan schrijven, waardoor het sneller werkt.

Private Sub Worksheet_Activate()

Dim WsWerknemers As String
WsWerknemers = "Personeelsbestand"

Worksheets("1").Range("A1").Activate

If Sheets("1").Range("D3") > 0 Then
    Rows("1:3").Select
    Selection.EntireRow.Hidden = True
    Range("A1").Select
End If

Dim rBereik As Range
    For Each rBereik In Range("A9:A502")
        If rBereik.Value <> "" And IsDate(rBereik) Then
            Range("I" & rBereik.Row).Value = Year(rBereik) & Month(rBereik)
        End If
    Next
    
Dim dTarief As Double
    dTarief = Worksheets(WsWerknemers).Range("D3").Value
    For Each rBereik In Range("B9:B502")
        If rBereik.Value <> "" Then
            With Worksheets(WsWerknemers).Range("E2:S2")
                Set Apotheek = .Find(rBereik.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not Apotheek Is Nothing Then
                    Range("H" & rBereik.Row).Value = Worksheets(WsWerknemers).Cells(3, Apotheek.Column) * dTarief
                End If
            End With
        End If
    Next
    
End Sub

 

[Wigi]

1. ScreenUpdating en Calculation bekijken
2. voor lus 1: doe dit met een autofilter ipv een (trage) lus
3. voor lus 2: warom geen formule in Excel (HORIZ.ZOEKEN bijvoorbeeld), vermenigvuldigd met een vaste celverwijzing?

Wigi

 

[deschrik]

Wigi, bedankt voor het meedenken!

Bij het activeren van een werkblad en dan screenupdating toepassen, gaat het daar sneller van? En wat moet ik precies van calculation bekijken?

Voor lus 2 heb ik trouwens express geen formule in Excel (HORIZ.ZOEKEN bijvoorbeeld), vermenigvuldigd met een vaste celverwijzing gebruikt. Dit had ik in eerste instantie wel, maar hier werd het excelbestand uitermate groot van. Nadat ik dit heb veranderd in vba code is het bestand van 10 mb naar 2 mb gegaan.

 

[Wigi]

Bij het activeren van een werkblad en dan screenupdating toepassen, gaat het daar sneller van?

Denk je dat ik je met een kluitje in het riet stuur?

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

'code

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

En gebruik zeker ook de zoekfunctie van het forum, en Google. Deze dingen zijn echt makkelijk te vinden.

Wigi

 

[snb]

suggestie (niet getest)

Private Sub Worksheet_Activate()
  Rows("1:3").EntireRow.Hidden =Sheets("1").Range("D3") > 0
  With sheets("Personeelsbestand")
    For Each cl In Range("A9:A502")
      If IsDate(cl.value) Then cl.offset(,8).Value = format(cl.value,"yyyymm")
      if cl.offset(,1)<>"" then Range("E2:S2").Find(cl.offset(,1).value).offset(,3).value=.cells(3,5)*.cells(3,4)
    Next
  End With
End Sub

 

[deschrik]

Wigi, bedankt.. hij werkt nu inderdaad aanzienlijk sneller!

snb: hij geeft een fout in de volgende regel van de code en wel de fout: With of object is niet ingesteld:

Range("E2:S2").Find(cl.offset(,1).value).offset(,3).value=.cells(3,5)*.cells(3,4)

 

[Wigi]

Dit zal iets beter zijn, bij mij ook ongetest.

Private Sub Worksheet_Activate()
    Rows("1:3").EntireRow.Hidden = Sheets("1").Range("D3") > 0

    With Sheets("Personeelsbestand")
        For Each cl In Range("A9:A502")
            If IsDate(cl.Value) Then cl.Offset(, 8).Value = Format(cl.Value, "yyyymm")

            If cl.Offset(, 1) <> "" Then
            
                On Error Resume Next
                Range("H" & cl.Row).Value = .Cells(3, Range("E2:S2").Find(cl.Offset(, 1).Value).Column).Value * .Cells(3, 4).Value
                On Error GoTo 0

            End If

        Next
    End With
End Sub

Al zou ik het deel van de code dat niet op het geactiveerde blad betrekking heeft, helemaal niet in de Worksheet_Activate code zetten.

Wigi

 

[deschrik]

Wigi, hartelijk dank! Die code werkt perfect!:thumb:

 

[Wigi]

Graag gedaan.

Aub nog even de vraag op opgelost zetten.

 

[deschrik]

Wigi, ik heb toch nog een vraag omdat bij onderstaande code nog geen gegevens verschijnen. Wat betekent precies onderstaand deel??

Private Sub Worksheet_Activate()
               If cl.Offset(, 1) <> "" Then
            
                On Error Resume Next
                Range("H" & cl.Row).Value = .Cells(3, Range("E2:S2").Find(cl.Offset(, 1).Value).Column).Value * .Cells(3, 4).Value
                On Error GoTo 0

            End If

        Next
    End With
End Sub

 

[Wigi]

Range("E2:S2").Find(cl.Offset(, 1).Value)

zal de cel rechts van de cel cl opzoeken in het bereik E2:S2.

Daarvan neem je het kolomnummer (.Column)

Dan zoek je in rij 3 naar die kolom, en neemt de waarde daaruit:

.Cells(3, ....Column).Value

Dat vermenigvuldig je met cel D3.

Dat resultaat komt in kolom H van dezelfde rij als de rij van cel cl.

Wigi

 

[deschrik]

Duidelijk Wigi!:thumb:

Alleen wel raar dan dat hij niet werkt.:shocked:

 

[Wigi]

Haal

                On Error Resume Next

eens uit de code, dan zie je waar het mangelt.

Wigi

 

[deschrik]

Hmm, hij mangelt in onderstaande code:

Range("H" & cl.Row).Value = .Cells(3, Range("E2:S2").Find(cl.Offset(, 1).Value).Column).Value * .Cells(3, 4).Value

 

[Wigi]

Hmm, hij mangelt in onderstaande code:

Range("H" & cl.Row).Value = .Cells(3, Range("E2:S2").Find(cl.Offset(, 1).Value).Column).Value * .Cells(3, 4).Value

Waarschijnlijk...

Doe dit nog een paar keer, achtereenvolgens minder en minder code in die regel, en zie of het probleem nog blijft bestaan. Indien niet, dan weet je dat er met dat stuk geen probleem is.

Het probleem zal ontstaan als er niets gevonden kan worden met de Find.

Wigi