• 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 loopt traag

Status
Niet open voor verdere reacties.
stefano

stefano

Gebruiker
Lid geworden
22 mei 2004
Berichten
865
In een bestand importeer ik op drie tabbladen gegevens uit drie aparte excels.

Daarna plaats ik een formule in een cel en kopieer deze naar een gebied met onderstaande code. Deze macro loopt heel traag ( 1 cel per 1 a 2 seconden ... ).

Komt dit door mijn code?



Code: 
Sub Orders_SAP_tonen()
Dim laatsterij As Long
    laatsterij = ActiveSheet.UsedRange.Rows.Count
'    Range("F7:G1000").ClearContents
    Range("F7:G1000").Select
    Selection.Delete Shift:=xlUp
    Range("F6").Select
    For i = 7 To laatsterij
        Range("F" & i).Select
        ActiveCell.FormulaR1C1 = _
            "=IFERROR(VLOOKUP(LEFT(RC[-5],7),orders!C[-4]:C[20],7,FALSE),"""")"
    Range("G6").Select
    Next i
    For j = 7 To laatsterij
        Range("G" & j).Select
        ActiveCell.FormulaR1C1 = _
            "=IFERROR(VLOOKUP(LEFT(RC[-6],7),orders!C[-5]:C[19],4,FALSE),"""")"
    Next j
    Range("A1").Select
End Sub

De codes voor het importeren zijn:

Code: 
Sub Importeren_zstocklist()
    Dim Pad As String
    Pad = Sheets("SRN").Range("B1")
    Application.DisplayAlerts = False
    Workbooks.Open Filename:=Pad & "zstock_list.xls"
    ActiveWorkbook.SaveAs Filename:=Pad & "zstock_list.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    Columns("A:I").Select
    Selection.Copy
    Windows("Tool.xlsm").Activate
    Sheets("stock").Select
    Range("A1").Select
 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("planning zakgoed").Select
    Windows("Zstock_list.xlsx").Activate
    ActiveWorkbook.Close False
    Application.DisplayAlerts = True
End Sub
Sub Importeren_zbeh_lijst_e()
    Dim Pad As String
    Pad = Sheets("SRN").Range("B1")
    Application.DisplayAlerts = False
    Workbooks.Open Filename:=Pad & "zbehlijst_e.xls"
    ActiveWorkbook.SaveAs Filename:=Pad & "zbehlijst_e.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    Windows("Tool.xlsm").Activate
    Sheets("temp").Select
    Columns("A:Z").Select
    Selection.Copy
    Range("A1").Select
    Sheets("Behoefte").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("planning zakgoed").Select
'    Windows("ZBEHlijst_E.xlsx").Activate
'    ActiveWindow.Close False
    Range("C2").Select
    Application.DisplayAlerts = True
    
End Sub
Sub Importeren_orders()
   Dim Pad As String
    Pad = Sheets("SRN").Range("B1")
    Application.DisplayAlerts = False
    Workbooks.Open Filename:=Pad & "Orders.xls"
    ActiveWorkbook.SaveAs Filename:=Pad & "Orders.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    Columns("A:Z").Select
    Selection.Copy
    Windows("Tool.xlsm").Activate
    Sheets("Orders").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("planning zakgoed").Select
    Windows("Orders.xlsx").Activate
    ActiveWorkbook.Close False
    Application.DisplayAlerts = True
End Sub
 
Voorkom het gebruik van .Select
Zet aan het begin van de macro Application.ScreenUpdating op False en Application.Calculation op xlCalculationManual
Aan het einde weer op True en xlCalculationAutomatic
 
Beste,
we hebben al tig aantal keren gezegd dat select meestal overbodig is en je code vertraagt, maar je blijft maar selects gebruiken.
Probeer deze eens,zie of het sneller gaat.
Code: 
Sub Orders_SAP_tonen()
laatsterij = ActiveSheet.UsedRange.Rows.Count
'    Range("F7:G1000").ClearContents
    Range("F7:G1000").Delete Shift:=xlUp
    For i = 7 To laatsterij
        Range("F" & i).FormulaR1C1 = "=IFERROR(VLOOKUP(LEFT(RC[-5],7),orders!C[-4]:C[20],7,FALSE),"""")"
        Range("F" & i).Offset(0, 1).FormulaR1C1 = "=IFERROR(VLOOKUP(LEFT(RC[-6],7),orders!C[-5]:C[19],4,FALSE),"""")"
    Next i
End Sub
 
Ik weet/wist dat .Select dient vermeden te worden maar ik heb de gewoonte één en ander met de macrorecorder uit te voeren ...

Excuus dat ik een slechte leerling ben :(

Met de nieuwe code duurt het proces even lang. De oorzaak ligt dus wellicht niet alleen bij die code.

Kan het zijn dat door het importeren van die gegevens uit de verschillende bestanden er een tekort aan geheugen optreedt ?

PS: In kader van niet gebruiken .Select: als ik nu na uitvoeren van jouw macro op cel A1 wil gaan staan (ctrl-home) hoe voer ik dat dan uit ?
 
Laat dan eens zien hoe je de raad van gast0660 en mij hebt opgevolgd.
 
Brrr, nu komt het ... Mijn aanpassingen hieronder, van ... naar

Code: 
Sub Importeren_zstocklist()
    Dim Pad As String
    Pad = Sheets("SRN").Range("B1")
    Application.DisplayAlerts = False
    Workbooks.Open Filename:=Pad & "zstock_list.xls"
    ActiveWorkbook.SaveAs Filename:=Pad & "zstock_list.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    Columns("A:I").Select
    Selection.Copy
    Windows("Tool.xlsm").Activate
    Sheets("stock").Select
    Range("A1").Select
 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("planning zakgoed").Select
    Windows("Zstock_list.xlsx").Activate
    ActiveWorkbook.Close False
    Application.DisplayAlerts = True
End Sub

naar

Code: 
Sub Importeren_zstocklist_noselect()
    Dim Pad As String
    Pad = Sheets("SRN").Range("B1")
    Application.DisplayAlerts = False
    Workbooks.Open Filename:=Pad & "zstock_list.xls"
    ActiveWorkbook.SaveAs Filename:=Pad & "zstock_list.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    Application.Goto (ActiveWorkbook.Sheets("sheet1").Range("A:I"))
'    Columns("A:I").Select
    Selection.Copy
    Windows("Tool.xlsm").Activate
    Application.Goto (ActiveWorkbook.Sheets("stock").Range("A1"))
'    Sheets("stock").Select
'    Range("A1").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.Goto (ActiveWorkbook.Sheets("stock").Range("A1"))
'   Range("A1").Select
    Sheets("planning zakgoed").Select
' zou niet weten hoe bovenstaande select te vervangen Application.Goto (ActiveWorkbook.Sheets("planning zakgoed") ?
    Windows("Zstock_list.xlsx").Activate
    ActiveWorkbook.Close False
    Application.DisplayAlerts = True
End Sub
 
Daar zit dus niet in wat ik in #2 zei.
 
Klopt, ik was begonnen met de .Select er uit te gooien.

Code: 
Sub Importeren_zstocklist_noselect()
    Dim Pad As String
    Pad = Sheets("SRN").Range("B1")
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Application.DisplayAlerts = False
    Workbooks.Open Filename:=Pad & "zstock_list.xls"
    ActiveWorkbook.SaveAs Filename:=Pad & "zstock_list.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    Application.Goto (ActiveWorkbook.Sheets("sheet1").Range("A:I"))
'    Columns("A:I").Select
    Selection.Copy
    Windows("Tool.xlsm").Activate
    Application.Goto (ActiveWorkbook.Sheets("stock").Range("A1"))
'    Sheets("stock").Select
'    Range("A1").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.Goto (ActiveWorkbook.Sheets("stock").Range("A1"))
'   Range("A1").Select
    Sheets("planning zakgoed").Select
' zou niet weten hoe te vervangen Application.Goto (ActiveWorkbook.Sheets("planning zakgoed") ?
    Windows("Zstock_list.xlsx").Activate
    ActiveWorkbook.Close False
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub
 
@Dotchie

is mijn poging om .Select te vermijden ok ?

Wat met

Code: 
Sheets("planning zakgoed").Select
' zou niet weten hoe te vervangen Application.Goto (ActiveWorkbook.Sheets("planning zakgoed") ?

@Ed

loopt als een trein nu!

dank je wel !
 
Dat gaat niet werken stefano.. En hier wordt soms ook wel erg krampachtig gedaan over helemaal geen selects.. dat is het punt niet.
Als jij na uitvoering van een macro de A1 de actieve cel wil maken is er weinig mis met een Range("A1").select

Dus even als voorbeeld

AL deze regels kun je vervangen door.

Code: 
Columns("A:I").Select
    Selection.Copy
    Windows("Tool.xlsm").Activate
    Sheets("stock").Select
    Range("A1").Select
 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select

Kun je ook vangen in

Code: 
Columns("A:I").Copy
Sheets("stock").Range("A1").PasteSpecial Paste:=xlPasteValues
Range("A1").Select

Als de macro in workbook Tools.xlsm staat hoef je niet opnieuw dat workbook te activeren. Verwijzen naar de juiste sheet en startcel is voldoende
en hier is ook de select-selection combinatie op de juiste wijze ge-elimineerd
 
Verdiep je eens in Activeworkbook en Thisworkbook. Je hebt helemaal geen activate, select of goto nodig.
 
Beste allen,

Dank voor jullie antwoorden en steun, ik waardeer dit ten zeerste.

Ik ben ook begonnen met het boek 'Microsoft Ecel VBA voor professionals' van Wim De Groot te lezen. 793 pagina's maar alleen lezen helpt me niet vooruit, ik moet het ook begrijpen (en onthouden).

Ik wil maar zeggen, ik doe mijn best ;)

dank !!
 
Volgens mij moet deze heel wat efficienter kunnen:
Code: 
Sub Orders_SAP_tonen()
laatsterij = ActiveSheet.UsedRange.Rows.Count
'    Range("F7:G1000").ClearContents
    Range("F7:G1000").Delete Shift:=xlUp
    For i = 7 To laatsterij
        Range("F" & i).FormulaR1C1 = "=IFERROR(VLOOKUP(LEFT(RC[-5],7),orders!C[-4]:C[20],7,FALSE),"""")"
        Range("F" & i).Offset(0, 1).FormulaR1C1 = "=IFERROR(VLOOKUP(LEFT(RC[-6],7),orders!C[-5]:C[19],4,FALSE),"""")"
    Next i
End Sub

Namelijk zo:

Code: 
Sub Orders_SAP_tonen()
    laatsterij = ActiveSheet.UsedRange.Rows.Count
    Range("F7:G" & laatsterij).Delete Shift:=xlUp
    Range("F7:F" & laatsterij).FormulaR1C1 = "=IFERROR(VLOOKUP(LEFT(RC[-5],7),orders!C[-4]:C[20],7,FALSE),"""")"
    Range("F7:F" & laatsterij).Offset(0, 1).FormulaR1C1 = "=IFERROR(VLOOKUP(LEFT(RC[-6],7),orders!C[-5]:C[19],4,FALSE),"""")"
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan