• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

macro uitvoeren duurt te lang

Status
Niet open voor verdere reacties.
W

westra77

Gebruiker
Lid geworden
2 mrt 2007
Berichten
149
onderstaande code werkt als resultaat precies naar mijn verwachting
echter de macro heeft erg lang werk (30 sec)om de code te doorlopen.
daarnaast sorteert de macro niet meer indien ik de rijen a7:l30 verberg
waardoor heeft de macro zo lang werk?
alvast bedankt


Code: 
Sheets("mengopdracht").Unprotect ("joppe")

Sheets("mengopdracht").Select
    Range("A7:L30").Select
    Selection.Sort Key1:=Range("a7"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal


Dim c As Range
    
    For Each c In Sheets("mengopdracht").Range("s8:s27")
        With c
            If Len(Sheets("mengopdracht").Range("c" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Round(Sheets("mengopdracht").Range("m" & .Row).Value, 0) & "(" & Round(Sheets("mengopdracht").Range("c" & .Row).Value, 0) & ")"
                .Characters(Len(Round(Sheets("mengopdracht").Range("m" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("c" & .Row).Value, 0)) + 2).Font.Bold = True
                .Characters(Len(Round(Sheets("mengopdracht").Range("m" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("c" & .Row).Value, 0)) + 2).Font.Size = 8
        
            End If
        End With
    Next c
    
Dim d As Range
    
    For Each d In Sheets("mengopdracht").Range("t8:t27")
        With d
            If Len(Sheets("mengopdracht").Range("e" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Round(Sheets("mengopdracht").Range("n" & .Row).Value, 0) & "(" & Round(Sheets("mengopdracht").Range("e" & .Row).Value, 0) & ")"
                .Characters(Len(Round(Sheets("mengopdracht").Range("n" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("e" & .Row).Value, 0)) + 2).Font.Bold = True
                .Characters(Len(Round(Sheets("mengopdracht").Range("n" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("e" & .Row).Value, 0)) + 2).Font.Size = 8
                .Characters(Len(Round(Sheets("mengopdracht").Range("n" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("e" & .Row).Value, 0)) + 2).Font.Color = vbBlack
   
            End If
        End With
    Next d
    
    Dim e As Range
    
    For Each e In Sheets("mengopdracht").Range("u8:u27")
        With e
            If Len(Sheets("mengopdracht").Range("g" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Round(Sheets("mengopdracht").Range("o" & .Row).Value, 0) & "(" & Round(Sheets("mengopdracht").Range("g" & .Row).Value, 0) & ")"
                .Characters(Len(Round(Sheets("mengopdracht").Range("o" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("g" & .Row).Value, 0)) + 2).Font.Bold = True
                .Characters(Len(Round(Sheets("mengopdracht").Range("o" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("g" & .Row).Value, 0)) + 2).Font.Size = 8
        
            End If
        End With
    Next e
    
    Dim f As Range
    
    For Each f In Sheets("mengopdracht").Range("v8:v27")
        With f
            If Len(Sheets("mengopdracht").Range("h" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Round(Sheets("mengopdracht").Range("p" & .Row).Value, 0) & "(" & Round(Sheets("mengopdracht").Range("h" & .Row).Value, 0) & ")"
                .Characters(Len(Round(Sheets("mengopdracht").Range("p" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("h" & .Row).Value, 0)) + 2).Font.Bold = True
                .Characters(Len(Round(Sheets("mengopdracht").Range("p" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("h" & .Row).Value, 0)) + 2).Font.Size = 8
        
            End If
        End With
    Next f
    
    Dim g As Range
    
    For Each g In Sheets("mengopdracht").Range("w8:w27")
        With g
            If Len(Sheets("mengopdracht").Range("j" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Round(Sheets("mengopdracht").Range("q" & .Row).Value, 0) & "(" & Round(Sheets("mengopdracht").Range("j" & .Row).Value, 0) & ")"
                .Characters(Len(Round(Sheets("mengopdracht").Range("q" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("j" & .Row).Value, 0)) + 2).Font.Bold = True
                .Characters(Len(Round(Sheets("mengopdracht").Range("q" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("j" & .Row).Value, 0)) + 2).Font.Size = 8
                .Characters(Len(Round(Sheets("mengopdracht").Range("q" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("j" & .Row).Value, 0)) + 2).Font.Color = vbBlack

            End If
        End With
    Next g

    Dim h As Range
    
    For Each h In Sheets("mengopdracht").Range("x8:x27")
        With h
            If Len(Sheets("mengopdracht").Range("l" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Round(Sheets("mengopdracht").Range("r" & .Row).Value, 0) & "(" & Round(Sheets("mengopdracht").Range("l" & .Row).Value, 0) & ")"
                .Characters(Len(Round(Sheets("mengopdracht").Range("r" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("l" & .Row).Value, 0)) + 2).Font.Bold = True
                .Characters(Len(Round(Sheets("mengopdracht").Range("r" & .Row).Value, 0)) + 1, Len(Round(Sheets("mengopdracht").Range("l" & .Row).Value, 0)) + 2).Font.Size = 8
        
            End If
        End With
    Next h
    
    If Sheets("invoer mengopdracht").Range("m44").Value = 0 Or _
       Sheets("invoer mengopdracht").Range("m44").Value = 2 Then
        
        Sheets("mengopdracht").Range("d8:d27").Copy
        Sheets("mengopdracht").Range("c63:c82").PasteSpecial Paste:=xlPasteValues
        Sheets("mengopdracht").Range("c63:c82").NumberFormat = "0"
        
        Sheets("mengopdracht").Range("e8:e27").Copy
        Sheets("mengopdracht").Range("d63:d82").PasteSpecial Paste:=xlPasteValues
        Sheets("mengopdracht").Range("d63:d82").NumberFormat = "0"
        Sheets("mengopdracht").Range("d63:d82").Font.Color = vbBlack
        
        Sheets("mengopdracht").Range("f8:f27").Copy
        Sheets("mengopdracht").Range("e63:e82").PasteSpecial Paste:=xlPasteValues
        Sheets("mengopdracht").Range("e63:e82").NumberFormat = "0"
        
        Sheets("mengopdracht").Range("i8:i27").Copy
        Sheets("mengopdracht").Range("g63:g82").PasteSpecial Paste:=xlPasteValues
        Sheets("mengopdracht").Range("g63:g82").NumberFormat = "0"
        
        Sheets("mengopdracht").Range("j8:j27").Copy
        Sheets("mengopdracht").Range("h63:h82").PasteSpecial Paste:=xlPasteValues
        Sheets("mengopdracht").Range("h63:h82").NumberFormat = "0"
        Sheets("mengopdracht").Range("h63:h82").Font.Color = vbBlack
        
        Sheets("mengopdracht").Range("k8:k27").Copy
        Sheets("mengopdracht").Range("i63:i82").PasteSpecial Paste:=xlPasteValues
        Sheets("mengopdracht").Range("i63:i82").NumberFormat = "0"
    
    ElseIf Sheets("invoer mengopdracht").Range("m44").Value = 1 Then
        Sheets("mengopdracht").Range("d8:d27").Copy
        Sheets("mengopdracht").Range("c63:c82").PasteSpecial Paste:=xlPasteValues
        Sheets("mengopdracht").Range("c63:c82").NumberFormat = "0"
        
        Sheets("mengopdracht").Range("t8:t27").Copy Sheets("mengopdracht").Range("d63:d82")
        
        Sheets("mengopdracht").Range("f8:f27").Copy
        Sheets("mengopdracht").Range("e63:e82").PasteSpecial Paste:=xlPasteValues
        Sheets("mengopdracht").Range("e63:e82").NumberFormat = "0"
           
        Sheets("mengopdracht").Range("i8:i27").Copy
        Sheets("mengopdracht").Range("g63:g82").PasteSpecial Paste:=xlPasteValues
        Sheets("mengopdracht").Range("g63:g82").NumberFormat = "0"

        Sheets("mengopdracht").Range("w8:w27").Copy Sheets("mengopdracht").Range("h63:h82")
        
        Sheets("mengopdracht").Range("k8:k27").Copy
        Sheets("mengopdracht").Range("i63:i82").PasteSpecial Paste:=xlPasteValues
        Sheets("mengopdracht").Range("i63:i82").NumberFormat = "0"
       
    ElseIf Sheets("invoer mengopdracht").Range("m44").Value = 3 Then
        Sheets("mengopdracht").Range("s8:s27").Copy Sheets("mengopdracht").Range("c63:c82")
        Sheets("mengopdracht").Range("t8:t27").Copy Sheets("mengopdracht").Range("d63:d82")
        Sheets("mengopdracht").Range("u8:u27").Copy Sheets("mengopdracht").Range("e63:e82")
        Sheets("mengopdracht").Range("v8:v27").Copy Sheets("mengopdracht").Range("g63:g82")
        Sheets("mengopdracht").Range("w8:w27").Copy Sheets("mengopdracht").Range("h63:h82")
        Sheets("mengopdracht").Range("x8:x27").Copy Sheets("mengopdracht").Range("i63:i82")
    End If
Sheets("mengopdracht").Protect ("joppe")

End Sub
 
Waarom verschillende lussen doorheen kolom t, dan u, dan v,...

Maak 1 lus en gebruik de Offset eigenschap om cellen op dezelfde rij maar in een andere kolom, aan te spreken.

En Application.ScreenUpdating = False en nadien Application.ScreenUpdating = True zetten zal ook veel helpen.

Wigi
 
kun je/wil je mij een kleine voorzet geven??
ps door:Application.ScreenUpdating =false en true werkt de macro nu super snel
probleem met sorteren is nog niet opgelost.
 
Laatst bewerkt:
Nog een (algemene) opmerking. Je moet programmeren in VBA, maar steeds de link met Excel niet vergeten. Bvb. dit:

Code: 
        Sheets("mengopdracht").Range("s8:s27").Copy Sheets("mengopdracht").Range("c63:c82")
        Sheets("mengopdracht").Range("t8:t27").Copy Sheets("mengopdracht").Range("d63:d82")
        Sheets("mengopdracht").Range("u8:u27").Copy Sheets("mengopdracht").Range("e63:e82")
        Sheets("mengopdracht").Range("v8:v27").Copy Sheets("mengopdracht").Range("g63:g82")
        Sheets("mengopdracht").Range("w8:w27").Copy Sheets("mengopdracht").Range("h63:h82")
        Sheets("mengopdracht").Range("x8:x27").Copy Sheets("mengopdracht").Range("i63:i82")

ga je toch nooit manueel in Excel zo doen? Je kopieert alles in 2 keer (en als het aaneengesloten bereiken zouden zijn, kopieer je in 1 keer):

Code: 
Sheets("mengopdracht").Range("s8:u27").Copy Sheets("mengopdracht").Range("e63")
Sheets("mengopdracht").Range("v8:x27").Copy Sheets("mengopdracht").Range("g63")

Wigi
 
natuurlijk; ook in excel werk je op die methode. :rolleyes: (
(leermomentje)

echter ik blijf met het probleem zitten dat indien de rijen verborgen zijn, die geslecteerd moeten worden, dan niet meer gesorteerd worden. Indien ik de rijen zichtbaar maak werkt de macro wel juist. Ik wil echter de rijen niet zichtbaar hebben. Is hier een oplossing voor
 
Laatst bewerkt:
Waarom niet in de code die rijen zichtbaar maken, sorteren, en weer onzichtbaar?

Met ScreenUpdating merk je daar toch niets van.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan