• 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 duurt lang

Status
Niet open voor verdere reacties.
S

sjonnie1974

Gebruiker
Lid geworden
19 okt 2011
Berichten
177
Hallo,

ergens in mijn vba code zit

Windows("book1.xls").Activate
ActiveWindow.Close

Deze opdracht is binnen de seconde gedaan, wanneer ik dit handmatig doe, MAAR binnen de vba code duurt het bijna 3 seconden.
Misschien niet erg groot tijdsverschil, maar ik wil graag weten hoe ik dit binnen de vba kan oplossen!?

Iemand idee?
 
Waarom ga je eerst het bestand activeren en vervolgens sluiten?

Code: 
Windows("book1.xls").Close

Doet volgens mij hetzelfde.

Waarschijnlijk zit de vertragende factor ergens anders in de code. Maar die heb je niets geplaatst dus kan ik er niets over zeggen.
 
Laatst bewerkt:
Hoi,

de vraag begrijp ik, maar omdat ik niet alle codes uit mijn hoofd weet, neem ik vaak een macro op en die plak ik dan weer in mijn eigen vba. Excel laat dit dan op deze manier zien.
Echter wanneer ik jouw code gebruik (had ik al gaprobeerd) dan istie niet sneller :( De rest van de code is wel heel snel, maar juist steeds bij het afsluiten van bestanden blijftie vaak hangen.

Wat wil je van me weten om me verder te kunnen helpen?
 
'importeer de GADD_OR130a en sorteer deze op postcode
Code: 
Sheets("or130a").Select
Cells.Select
Selection.ClearContents

If Range("prenote!d9") = 888 Then
lijstor130apath = Range("[prenotetool.xlsm]substitute!b2")
lijstor130aname = Range("[prenotetool.xlsm]substitute!c2")
Else:
lijstor130apath = Range("[prenotetool.xlsm]substitute!e2")
lijstor130aname = Range("[prenotetool.xlsm]substitute!c2")
End If

    Workbooks.Open Filename:=lijstor130apath & lijstor130aname
    Sheets("Data").Select
    Cells.Select
    Selection.Copy
    Windows("Prenotetool.xlsm").Activate
    Sheets("or130a").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    Cells.Select
    ActiveWorkbook.Worksheets("or130a").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("or130a").Sort.SortFields.Add Key:=Range("F2:F15531") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("or130a").Sort
        .SetRange Range("A1:r15531")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A2").Select
    
    Windows(lijstor130aname).Activate
    ActiveWindow.Close
    
'importeer de GADD_OR130b en sorteer deze op postcode
Sheets("or130b").Select
Cells.Select
Selection.ClearContents

If Range("prenote!d9") = 888 Then
lijstor130bpath = Range("[prenotetool.xlsm]substitute!b3")
lijstor130bname = Range("[prenotetool.xlsm]substitute!c3")
Else:
lijstor130bpath = Range("[prenotetool.xlsm]substitute!e3")
lijstor130bname = Range("[prenotetool.xlsm]substitute!c3")
End If

    Workbooks.Open Filename:=lijstor130bpath & lijstor130bname
    Sheets("Data").Select
    Cells.Select
    Selection.Copy
    Windows("Prenotetool.xlsm").Activate
    Sheets("or130b").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    Cells.Select
    ActiveWorkbook.Worksheets("or130b").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("or130b").Sort.SortFields.Add Key:=Range("C2:C11324") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("or130b").Sort.SortFields.Add Key:=Range("B2:B11324") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("or130b").Sort
        .SetRange Range("A1:N11324")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Windows(lijstor130bname).Activate
    ActiveWindow.Close
 
Laatst bewerkt door een moderator:
Zie even de wijziging in mijn bericht. Lol die had je dus gezien.:D Maar plaats eerst je code even tussen de tags en het liefst ook een voorbeeldbestandje.
 
Laatst bewerkt:
Hej VenA,

Wat ik hierboven in de code niet heb gezegd is dat deze code begint met de regel call M_start

In deze code staat:

Code: 
Sub M_start()

'ctrl-shift-S

Sheets("progressing").Visible = True
Sheets("progressing").Select

With Application
    .DisplayScrollBars = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Sheets("or130a").Visible = True
Sheets("or130b").Visible = True
Sheets("prenote mh").Visible = True
Sheets("prenote zb").Visible = True
Sheets("substitute").Visible = True
Sheets("boodschap").Visible = True
Sheets("msl").Visible = True
Sheets("stand paklijst").Visible = True
Sheets("ber sp").Visible = True

Sheets("prenote").Unprotect Password:=""
Sheets("or130a").Unprotect Password:=""
Sheets("or130b").Unprotect Password:=""
Sheets("prenote mh").Unprotect Password:=""
Sheets("boodschap").Unprotect Password:=""
Sheets("substitute").Unprotect Password:=""
Sheets("prenote zb").Unprotect Password:=""
Sheets("msl").Unprotect Password:=""
Sheets("stand paklijst").Unprotect Password:=""
Sheets("ber sp").Unprotect Password:=""

Sheets("prenote mh").Select
Rows("1:1").Select
    Selection.EntireRow.Hidden = False
Sheets("prenote zb").Select
Rows("1:1").Select
    Selection.EntireRow.Hidden = False
Sheets("msl").Select
Rows("1:1").Select
    Selection.EntireRow.Hidden = False

Sheets("prenote").Select

End Sub

ALS IK DEZE CALL M_START NIET UITVOER, GAAT HET WEL SNELLER.... ???
 
Laatst bewerkt door een moderator:
excuus, ik had het gelezen, maar wist niet hoe het moest.
bedankt voor de tip!
 
Zet dit direct onder Sub M_START():
Application.ScreenUpdating = False

En dan dit net voor de End Sub:
Application.ScreenUpdating = True

Dat zal wellicht schelen.
 
Edmoor,

Deze regels staan al in code M_start, gaat dit dan nog wat uitmaken als ik het er nog eens inzet?
Ik kan het nu niet direct proberen, maar vraag me het af
 
Nee, dat zal niks uitmaken. Ik las er overheen in je voorbeeld.
 
Je kan misschien die code wat inkorten en die select er uit halen:

Code: 
Sub M_start()

'ctrl-shift-S

With Sheets("progressing")
        .Visible = True

  With Application
    .DisplayScrollBars = False
    .ScreenUpdating = False
    .DisplayAlerts = False
  End With
    For Each ws In ThisWorkbook.Sheets
        .Visible = True
        .Unprotect
    Next
End With

Sheets("prenote mh").Rows("1:1").EntireRow.Hidden = False
Sheets("prenote zb").Rows("1:1").EntireRow.Hidden = False
Sheets("msl").Rows("1:1").EntireRow.Hidden = False
End Sub
 
Laatst bewerkt:
@Cobbe
De 1e With kan er eigenlijk wel uit.
Belangrijker, er staat per ongeluk witj

Met vriendelijke groet,


Roncancio
 
Heren, allemaal bedankt, maar uiteindelijk heeft jullie hulp niet geholpen.
Wel ben ik er zelf achtergekomen dat:
VBA heeft lange tijd nodig om een activewindows.close uit te voeren. Dit komt doordat er een groot gedeelte geheugen gebruikt is. Zet ik dus de Application.CutCopyMode = False voor de .close dan gaat het super veel sneller!

Nogmaals allen bedankt!
 
Dan had je dus een heel ander probleem.

vervang
Code: 
    Sheets("Data").Select
    Cells.Select
    Selection.Copy
    Windows("Prenotetool.xlsm").Activate
    Sheets("or130a").Select
    Range("A1").Select
    ActiveSheet.Paste

door
Code: 
  workbooks("prenotetool.xlsm").Sheets("or130a").delete
  thisworkbook.sheets("data").copy workbooks("prenotetool.xlsm").sheets(workbooks("prenotetool.xlsm").sheets.count)
  workbooks("prenotetool.xlsm").sheets(workbooks("prenotetool.xlsm").sheets.count).name="or130a"

Kijk voor de lol ook eens naar de lemmata 'usedrange' en 'currentregion' in de hulpbestanden van de VBEditor.
Maar vermijd vooral iedere 'select' en 'activate' in VBA !
 
Laatst bewerkt:
Hoi,

Ik ga mijn best doen, maar de reden dat ik deze er wel in heb staan is dat ik het dan allemaal nog een klein beetje kan volgen.
Waar kan ik die usedrange en currentregion vinden dan? via menu?
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan