Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro beschleunigen?

Forumthread: Makro beschleunigen?

Makro beschleunigen?
Günter
Guten Tag,
haben unten stehendes Makro von Peter Feustel.
Ist es möglich die Aufgabe (Abgleich) zu beschleunigen?
Makro läuft bei 80.000 Datensätzen ca. 1,5 Stunden.
Schönen Gruß
Günter
For lZeile_A = 13 To WkSh_A.Cells(Rows.Count, 14).End(xlUp).Row
With WkSh_N.Columns(14)
Set rZelle = .Find(What:=WkSh_A.Range("N" & lZeile_A).Value, LookAt:=xlWhole, _
LookIn:=xlValues)
If rZelle Is Nothing Then
lZeile_F = lZeile_F + 1
WkSh_A.Rows(lZeile_A).Copy Destination:=WkSh_F.Rows(lZeile_F)
End If
End With
Next lZeile_A
Anzeige
AW: Makro beschleunigen?
18.10.2010 11:12:30
Klaus
Hallo Günther,
erstmal application.screenupdating = FALSE und die automatischen Berechnungen ausschalten. Nicht vergessen beides wieder anzuschalten!
Wie groß ist der zu kopierende Bereich? Bis ca. 5.000 Zellen ist es schneller, die Werte direkt zuzuweisen:
statt
WkSh_A.Rows(lZeile_A).Copy Destination:=WkSh_F.Rows(lZeile_F)
versuch
WkSh_F.Rows(lZeile_F).value = WkSh_A.Rows(lZeile_A).value
Und natürlich: Prozesse im Hintergrund ausschalten.
Schlussendlich kann man den Code bestimmt noch optimieren, nur dafür müsste man wissen was genau passieren soll .... aus deinem Codefetzen ist das leider nicht ersichtlich. Link zum Ursprungsthread?
Grüße,
Klaus M.vdT.
Anzeige
AW: Makro beschleunigen?
18.10.2010 11:19:44
Günter
Hallo Klaus,
Frage war: Hätte gerne per VBA, dass Spalte N in beiden Dateien abgeglichen
wird, und die Einträge, welche in "Alt" sind und nicht in "Neu"
in "Fehlende in Neu" geschrieben werden.
Gruß
Günter
hier meine Beispieldatei:
https://www.herber.de/bbs/user/71865.xls
Und hier der vollständige Code:
Option Explicit
Public Sub Abgleich()
Dim WkSh_A    As Worksheet
Dim WkSh_N    As Worksheet
Dim WkSh_F    As Worksheet
Dim lZeile_A  As Long
Dim lZeile_F  As Long
Dim rZelle    As Range
Application.ScreenUpdating = False
Set WkSh_A = ThisWorkbook.Worksheets("Alt")
Set WkSh_N = ThisWorkbook.Worksheets("Neu")
Set WkSh_F = ThisWorkbook.Worksheets("Fehlende in Neu")
lZeile_F = 12 ' die Start-Zeile in Fehlende in Neu minus 1
For lZeile_A = 13 To WkSh_A.Cells(Rows.Count, 14).End(xlUp).Row
With WkSh_N.Columns(14)
Set rZelle = .Find(What:=WkSh_A.Range("N" & lZeile_A).Value, LookAt:=xlWhole, _
LookIn:=xlValues)
If rZelle Is Nothing Then
lZeile_F = lZeile_F + 1
WkSh_A.Rows(lZeile_A).Copy Destination:=WkSh_F.Rows(lZeile_F)
End If
End With
Next lZeile_A
Application.ScreenUpdating = True
End Sub

Anzeige
ohne VBA?
18.10.2010 11:29:54
Klaus
Hallo Gunter,
das hätt ich jetzt mit Formeln gelöst ...
https://www.herber.de/bbs/user/71956.xls
Wenn du es zwingend als VBA brauchst, lass die Formellösung in einem seperatem Blatt laufen und kopiere die Ergebnisse per VBA als Inhalte-Einfügen.
Grüße,
Klaus M.vdT.
Anzeige
AW: ohne VBA?
18.10.2010 11:39:30
Günter
Vielen Dank Klaus!
Noch einen schönen Tag.
Gruß
Günter
Danke für die Rückmeldung! o.w.T.
18.10.2010 11:43:21
Klaus
.
AW: Makro beschleunigen?
18.10.2010 11:38:55
Rudi
Hallo,
teste mal:
Public Sub Abgleich()
Dim WkSh_A    As Worksheet
Dim WkSh_N    As Worksheet
Dim WkSh_F    As Worksheet
Dim lZeile_A  As Long
Dim lZeile_F  As Long
Dim rZelle    As Range
Dim arr_F(), i As Integer
Application.ScreenUpdating = False
Set WkSh_A = ThisWorkbook.Worksheets("Alt")
Set WkSh_N = ThisWorkbook.Worksheets("Neu")
Set WkSh_F = ThisWorkbook.Worksheets("Fehlende in Neu")
ReDim arr_F(1 To 14, 1 To Application.CountA(WkSh_A.Columns(14)))
lZeile_F = 0
For lZeile_A = 13 To WkSh_A.Cells(Rows.Count, 14).End(xlUp).Row
With WkSh_N.Columns(14)
Set rZelle = .Find(What:=WkSh_A.Cells(lZeile_A, 14).Value, LookAt:=xlWhole, _
LookIn:=xlValues)
If rZelle Is Nothing Then
lZeile_F = lZeile_F + 1
For i = 1 To 14
arr_F(i, lZeile_F) = WkSh_A.Cells(lZeile_A, i)
Next
End If
End With
Next lZeile_A
ReDim Preserve arr_F(1 To 14, 1 To lZeile_F)
arr_F = WorksheetFunction.Transpose(arr_F)
WkSh_F.Cells(13, 1).Resize(lZeile_F, 14) = arr_F
Application.ScreenUpdating = True
End Sub

Gruß
Rudi
Anzeige
AW: Makro beschleunigen?
18.10.2010 12:11:03
Günter
Hallo Rudi,
teste Deinen Code!
Lief jetzt los um: 12:07 Uhr
Gruß
Günter
AW: Makro beschleunigen?
18.10.2010 13:00:56
Günter
Hallo Rudi,
habe nur ein Viertel der Menge genommen und die Laufzeit
mal 4 multipliziert.
Ca. 1 Stunde ist die Laufzeit hochgerechnet.
Vielen Dank Rudi für die Zeitersparung.
Gruß
Günter
Anzeige
Neugierig: wie schlagen sich die Formeln?
18.10.2010 13:04:09
Klaus
Hallo Günter,
aus reiner Neugierde: funktioniert die Formellösung auch für dich und wie schlägt sie sich im Vergleich zum VBA Code?
Grüße,
Klaus M.vdT.
AW: Neugierig: wie schlagen sich die Formeln?
18.10.2010 13:24:56
Günter
Hallo Klaus,
melde mich hierzu noch.
Bis dann...
Gruß
Günter
10 Sekunden ?
18.10.2010 20:29:40
ransi
Hallo Günther
Ich habs auch mal mit VBA versucht.
100000 in alt, 100000 in neu.
Der Code braucht auf meinem Erbsenzähler ca. 10 Sekunden.
Option Explicit


Public Sub test()
Dim L As Long
Dim Out As Variant
Dim arrAlt As Variant
Dim arrNeu As Variant
Dim Z As Long
Dim I As Integer
Dim myDic As Object
Dim t As Double
t = Timer
arrAlt = Sheets("alt").Range("A13").CurrentRegion
arrNeu = Sheets("neu").Range("A13").CurrentRegion
Redim Out(1 To UBound(arrAlt), 1 To UBound(arrAlt, 2))
Set myDic = CreateObject("Scripting.Dictionary")
For L = LBound(arrNeu) To UBound(arrNeu)
    myDic(arrNeu(L, 14)) = 0
Next
For L = LBound(arrAlt) To UBound(arrAlt)
    If Not myDic.exists(arrAlt(L, 14)) Then
        Z = Z + 1
        For I = 1 To UBound(arrAlt, 2)
            Out(Z, I) = arrAlt(L, I)
        Next
    End If
Next
Sheets("Fehlende in neu").Range("A1").Resize(Z, UBound(arrAlt, 2)) = Out
MsgBox Timer - t
End Sub


ransi
Anzeige
AW: 10 Sekunden ?
19.10.2010 07:49:47
Günter
Hallo Ransi,
bin blatt. Gibt es nicht....
Muss mal diverse Mengentests machen.
Danke und Gruß
Günter
AW: Mischung aus Formeln und Code
19.10.2010 02:10:04
Daniel
Hi
hier mal ne Mischung aus Formellösung und Code.
die Fehlenden Werte werden mit der SVerweisformel ermittelt und dann kopiert.
damit das ganze schnell geht, werden die Daten umsortiert.
Sollte Sortiern aus irgendeinem Grund nicht möglich sein, fällt diese Lösung bei der genannten Datenmenge flach.
Sub test()
Dim rngAlt As Range
Dim rngNeu As Range
Set rngAlt = Range(Sheets("Alt").Cells(13, 14), Sheets("alt").Cells(Rows.Count, 14).End(xlUp))
Set rngNeu = Range(Sheets("neu").Cells(13, 14), Sheets("Neu").Cells(Rows.Count, 14).End(xlUp))
rngNeu.EntireRow.Sort key1:=rngNeu.Cells(1, 1), order1:=xlAscending, Header:=xlNo
With rngAlt.Offset(0, 1)
.FormulaR1C1 = "=If(vlookup(RC[-1],Neu!" & rngNeu.Address(1, 1, xlR1C1) & ",1,1)=RC[-1],1, _
true)"
.Copy
.PasteSpecial xlPasteValues
.EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
On Error Resume Next
.SpecialCells(xlCellTypeConstants, 20).Offset(0, -1).Copy Sheets("Fehlende in Neu").Cells(1, _
1)
On Error GoTo 0
.Clear
End With
End Sub
Gruß, Daniel
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige

Infobox / Tutorial

Makro effizienter gestalten und beschleunigen


Schritt-für-Schritt-Anleitung

  1. Initialisierung: Stelle sicher, dass Du Application.ScreenUpdating auf False setzt, um die Bildschirmaktualisierung während des Makros zu deaktivieren. Dies kann die Ausführungsgeschwindigkeit erheblich erhöhen.

    Application.ScreenUpdating = False
  2. Automatische Berechnung ausschalten: Deaktiviere die automatische Berechnung, um zu verhindern, dass Excel während der Ausführung Deines Makros ständig Berechnungen durchführt.

    Application.Calculation = xlCalculationManual
  3. Vermeidung von Copy-Paste: Anstatt die Zeilen zu kopieren, weise die Werte direkt zu. Dies kann die Ausführungszeit erheblich reduzieren.

    WkSh_F.Rows(lZeile_F).Value = WkSh_A.Rows(lZeile_A).Value
  4. Nutzung von Arrays: Arbeite mit Arrays, um Daten zwischen den Arbeitsblättern zu verarbeiten. Dies ist oft schneller, da es die Interaktion mit dem Excel-Arbeitsblatt minimiert.

    Dim arr_F() As Variant
    arr_F = WkSh_A.Range("A1:N" & lZeile_F).Value
  5. Ressourcen wiederherstellen: Vergiss nicht, Application.ScreenUpdating und Application.Calculation nach der Ausführung Deines Makros wieder auf True bzw. xlCalculationAutomatic zu setzen.

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

Häufige Fehler und Lösungen

  • Makro läuft zu langsam:

    • Lösung: Überprüfe, ob Application.ScreenUpdating und Application.Calculation korrekt gesetzt sind. Stelle sicher, dass Du Copy-Paste vermeidest und stattdessen Werte direkt zuweist.
  • Fehlende Daten:

    • Lösung: Stelle sicher, dass die Range-Referenzen korrekt sind und dass Du die richtigen Arbeitsblätter ansprichst.

Alternative Methoden

  • Formellösungen: Manchmal ist es effektiver, die Daten mit Formeln zu verarbeiten, wie z.B. mit der SVERWEIS-Funktion, und anschließend die Ergebnisse mit VBA zu kopieren, um die Verarbeitung zu beschleunigen.

  • Sortierung der Daten: Sortiere die Daten, bevor Du sie mit VBA abgleichst. Dies kann die Effizienz des Codes erheblich steigern.


Praktische Beispiele

Hier ist ein Beispiel, wie Du ein Makro zur Überprüfung von fehlenden Einträgen zwischen zwei Arbeitsblättern optimieren kannst:

Public Sub AbgleichOptimiert()
    Dim WkSh_A As Worksheet
    Dim WkSh_N As Worksheet
    Dim WkSh_F As Worksheet
    Dim arrAlt As Variant
    Dim arrNeu As Variant
    Dim i As Long
    Dim Z As Long

    Application.ScreenUpdating = False
    Set WkSh_A = ThisWorkbook.Worksheets("Alt")
    Set WkSh_N = ThisWorkbook.Worksheets("Neu")
    Set WkSh_F = ThisWorkbook.Worksheets("Fehlende in Neu")

    arrAlt = WkSh_A.Range("N13:N" & WkSh_A.Cells(Rows.Count, 14).End(xlUp).Row).Value
    arrNeu = WkSh_N.Range("N13:N" & WkSh_N.Cells(Rows.Count, 14).End(xlUp).Row).Value

    ' Code zur Bearbeitung der Arrays hier...

    Application.ScreenUpdating = True
End Sub

Tipps für Profis

  • Nutze das Dictionary-Objekt, um die Suche nach Werten zu beschleunigen.
  • Überlege, ob Du Multithreading für sehr große Datenmengen verwenden kannst.
  • Halte Deinen Code modular und gut strukturiert, um die Wartbarkeit zu erhöhen.

FAQ: Häufige Fragen

1. Wie kann ich die Laufzeit meines Makros weiter reduzieren? Vermeide unnötige Berechnungen und Interaktionen mit dem Arbeitsblatt. Nutze Arrays und optimiere die Verwendung von Schleifen.

2. Ist es besser, VBA oder Formeln zu verwenden? Das hängt von der Komplexität der Aufgabe ab. Bei großen Datenmengen kann VBA oft schneller sein, während Formeln für einfache Berechnungen geeignet sind.

3. Welche Excel-Version benötige ich für diese Techniken? Die beschriebenen Techniken sind in den meisten modernen Excel-Versionen verfügbar, darunter Excel 2010 und später.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige