hulp bij VBA gevraagd

[perry99]

Wie kan mij helpen met onderstaande VBA.
Het probleem is als ik data wil overzetten, alle maanden worden geleegd en opnieuw worden gevuld met data. Echter de data van januari t/m 2 september blijft ongewijzigd. Daar er erg veel data staat wat het programma overzet duurt dat erg lang voordat dat is
overgezet. Dit zou ik graag verkort willen zien. Mijn vraag is of het mogelijk is als de datum
vandaag 3 september is, dat alleen de data van september of vanaf september tot december wordt overgezet.
Ik hoop dat er iemand is die mij kan helpen.
Bij voorbaat dank. :thumb:
Perry

Sub overzetten_data()
Dim w As Range
Dim legeregel As Long

'laad de module werkbladen_leegmaken
Werkbladen_legen
   
For Each w In Sheets("OFFERTE REGISTRATIE").Range("A6:A" & Range("A65536").End(xlUp).Row)
    If w.Offset(0, 17) = 3 Then
        maand = Maandnaam(Month(Sheets("OFFERTE REGISTRATIE").Range("w" & w.Row))) & "2007"
        legeregel = Sheets(maand).Range("A100").End(xlUp).Row + 1
        With Sheets(maand)
            .Range("A" & legeregel) = Sheets("OFFERTE REGISTRATIE").Range("A" & w.Row)
            
        End With
    End If
Next
        
End Sub

Sub Werkbladen_legen()
Dim x As Integer
Dim y As Integer
Dim legeregelII As Long

y = 1

For x = 1 To ActiveWorkbook.Sheets.Count
    If Sheets(x).Name = Maandnaam(y) & "2007" Then
        legeregelII = Sheets(x).Range("A6:A500").Find(What:="", LookIn:=xlValues).Row
        Sheets(x).Range("A6:N" & legeregelII).ClearContents
        y = y + 1
    End If
Next

End Sub

Function Maandnaam(mnd As Integer) As String
    Select Case mnd
        Case 1: Maandnaam = "januari"
        Case 2: Maandnaam = "februari"
        Case 3: Maandnaam = "maart"
        Case 4: Maandnaam = "april"
        Case 5: Maandnaam = "mei"
        Case 6: Maandnaam = "juni"
        Case 7: Maandnaam = "juli"
        Case 8: Maandnaam = "augustus"
        Case 9: Maandnaam = "september"
        Case 10: Maandnaam = "oktober"
        Case 11: Maandnaam = "november"
        Case 12: Maandnaam = "december"
    End Select
End Function

 

[Wigi]

Vooraleer op je echte vraag in te gaan, een aantal bemerkingen over de huidige code:

Over hoeveel rijen gaat het? Hoe lang duurt de macro nu?

Een Autofilter is veel sneller voor veel rijen. Zie http://www.contextures.com/xlautofilter03.html

Iets verbeterde code (niet met autofilter):

Sub overzetten_data()

Dim w As Range
Dim wsOff As Worksheet
Dim legeregel As Long

Set wsOff = Sheets("OFFERTE REGISTRATIE")

'laad de module werkbladen_leegmaken
Werkbladen_legen
   
For Each w In wsOff.Range("A6:A" & Range("A" & Rows.Count).End(xlUp).Row)
    If w.Offset(0, 17) = 3 Then
        maand = Maandnaam(Month(wsOff.Range("w" & w.Row))) & "2007"
        legeregel = Sheets(maand).Range("A100").End(xlUp).Row + 1
        Sheets(maand).Range("A" & legeregel) = wsOff.Range("A" & w.Row)
    End If
Next

End Sub

Deze lussen begrijp ik niet:

Sub Werkbladen_legen()
Dim x As Integer
Dim y As Integer
Dim legeregelII As Long

y = 1

For x = 1 To ActiveWorkbook.Sheets.Count
    If Sheets(x).Name = Maandnaam(y) & "2007" Then
        legeregelII = Sheets(x).Range("A6:A500").Find(What:="", LookIn:=xlValues).Row
        Sheets(x).Range("A6:N" & legeregelII).ClearContents
        y = y + 1
    End If
Next

End Sub

Waarom niet gewoon een variabele van 1 tot 12 laten gaan, en dan het blad aanspreken zo?

Wigi

 

[Wigi]

Oh ja, die functie zou ik verkorten tot:

Function Maandnaam(mnd As Integer) As String
    Maandnaam = choose(mnd, "januari", "februari", "maart", ...) 'vul verder aan
End Function

maar daar gaat de echte tijdswinst niet zitten.

Wigi

 

[perry99]

Hallo Wigi,

Allereerst bedankt voor je reaktie, heb een bestandje bijgevoegd zodat je kunt zien wat
er allemaal gebeurd met de data.

Mijn inziens zitten er geen lussen in, echter heb er niet zoveel verstand van als dat jij dat
hebt.

Als ik de knop omzetten activeer met de het bestand waar ik mee werk, duurt dat ongeveer
40 tot 60 seconden.

Hoop dat je mij verder kan helpen.

Bij voorbaat dank.

Perry

 

[Wigi]

Mijn inziens zitten er geen lussen in, echter heb er niet zoveel verstand van als dat jij dat hebt.

Die For Each ... Next en de For ... Next zijn lussen

Het "probleem" daar zit hem in het feit dat je door alle rijen gaat, niet die enkel met een 3 in de juiste kolom. Dat maakt het traag (indien het over redelijk wat rijen gaat). Hoeveel rijen juist?

Als ik nog eens wat tijd heb zal ik het herschrijven, maar doe zelf al moeite met de Autofilter code in de link die ik gegeven heb.

Wigi

 

[perry99]

Nogmaals mijn dank voor jouw snelle reaktie Wigi.

Op dit moment staan er 400 rijen met data beschreven op het 1e blad.

Zal me verdiepen in autofilter code.

Hoop dat je tijd kan vinden voor het herschrijven.

Bij voorbaat mijn dank voor jouw medewerking :thumb::thumb::thumb::thumb::thumb:

Groetjes,

Perry

 

[Wigi]

Met 400 rijen loont het wel de moeite om de lussen te vervangen door de autofilter code. Kijk ook naar de SpecialCells(xlCellTypeVisible) die in die code staat. Dat is equivalent in VBA wanneer je in Excel zou doen: F5 drukken, Speciaal... klikken, dan "Alleen zichtbare cellen".

Succes ermee.

Wigi

 

[Wigi]

Dit is trouwens ook een interessante pagina in dit verband: http://www.ozgrid.com/VBA/VBALoops.htm