Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1876to1880
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro braucht ewig ..

Makro braucht ewig ..
14.04.2022 11:33:43
Fred
Hallo Excel,- VBA Experten,
ich nutze seit langen ein Makro, welches mir Daten von einem Sheet Unikate zum anderen Sheet Tagesliste zuordnet. Zufrieden bin ich nicht mit der Ablaufzeit des Makros bei vielen Datensätzen.
Beispiel:
DS Unikate : 300
DS Tagesliste: 16000
Dauer: über 1,5 Std.
Das muss doch auch schneller abgearbeitet werden!
Hier der Code

Dim lngZeile As Long
Dim lngSpalteMax As Long
Dim lngZeileMax As Long
Dim lngSpalte As Long
Dim lngZeileMax2 As Long
Dim VarDat As Variant
Dim i As Long
Dim sQuellSpalte As String
Dim sZielSpalte As String
Dim lngQuellZeile As Long
Dim lngQuellSpalte As Long
Dim lngZielZeile As Long
Dim lngZielSpalte As Long
Application.ScreenUpdating = False
LZ_UnikateClear2 = ThisWorkbook.Sheets("Tagesliste").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Tagesliste").Range("Y8:Z" & LZ_UnikateClear2).ClearContents
With Sheets("Unikate")
'Ermittel die letzte beschriebene Zeile in Spalte A "Unikate" und speichere den Wert in Variable lngZeileMax
lngZeileMax = .Range("A" & .Rows.Count).End(xlUp).Row
'Ermittel die Anzahl der beschriebenen Spalten in "unikate" und speichere den Wert in Variable lngSpalteMax
lngSpalteMax = .UsedRange.SpecialCells(xlCellTypeLastCell).Column  ' minus 1 weil letzte Spalte eine Hilfsspalte ist
'Ermittel die letzte beschriebene Zelle in Spalte A "Tagesliste" und speichere den Wert in Variable lngZeileMax2
lngZeileMax2 = Sheets("Tagesliste").Range("A" & .Rows.Count).End(xlUp).Row
'Schleife zum durchsuchen der Zeilen von Zeile 5 beginnend bis zur letzten beschriebenen Zeile in Spalte A
For lngZeile = 5 To lngZeileMax
'Definiere Suchbereich der Schleife
VarDat = Sheets("Tagesliste").Range("A2:A" & lngZeileMax2)
'Pruefe nun Zeile fuer Zeile im definierten Suchbereich VarDat
For i = 1 To UBound(VarDat)
'Wenn der Wert in der Zeile "Live" = Wert in der Zeile "import"
If .Range("A" & lngZeile).Value = VarDat(i, 1) Then
'dann starte neue Schleife und beginne mit Uebertrag der Daten in die Zielzeile und Zielspalte
For lngSpalte = 21 To (lngSpalteMax + 0) ' kopiert ab Spalte
lngQuellZeile = lngZeile
lngQuellSpalte = lngSpalte
lngZielZeile = i + 1
lngZielSpalte = lngQuellSpalte + 4 ' fügt ein ab Spalte
'Übertrage Daten in die Spalten
Sheets("Tagesliste").Cells(lngZielZeile, lngZielSpalte).Value = .Cells(lngQuellZeile, lngQuellSpalte).Value
Next lngSpalte
End If
Next i
Next lngZeile
End With
Application.CutCopyMode = True
relevant
Sheet Unikate mit formatierter Tabelle tb_Unikate
Beginn A4 (Titel)
zu vergleichende Werte: in Spalte A
zu übermittelnde Werte: in Spalten U:V
Sheet Tagesliste mit formatierter Tabelle tb_Tagesliste
Beginn A7 (Titel)
zu vergleichende Werte: in Spalte A
einzufügende Werte: in Spalten U:V
Kann mir bitte ein Experte dieses Makro in Hinsicht auf die "Abarbeitungszeit" optimieren oder einen ganz anderen "Makroablauf" schreiben?
viele Grüße
Fred

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro braucht ewig ..
14.04.2022 11:43:27
Fennek
Hallo,
bei den wenigen Zahlen und dem, zumindest auf den ersten Blick, aufgeräumten VBA-Code, könnte die URsache der Laufzeit in vielen Formeln, vielleicht mit Zugriff auf andere Dateien, liegen.
Vorschlag für einen Test:
Von Hand im Menü "Formeln" die Berechnung auf "manuell" setzen, dann den VBA-Code starten.
mfg
AW: Makro braucht ewig ..
14.04.2022 12:57:38
Fred
hallo, zuvor eine Korrektur:
Sheet Tagesliste mit formatierter Tabelle tb_Tagesliste
einzufügende Werte: in Spalten V:Z (statt U:V)
hallo Fennek,
ich habe in Formeln / BerechnungsOptionen manuell eingetragen.
In Sheet Unikate sind 300 DS
in Sheet Tagesliste sind 34.000 DS
= das Makro läuft seit 1 Stunde
Geht das echt nicht schneller?
Gruss
Fred
Anzeige
AW: Makro braucht ewig ..
14.04.2022 13:11:21
Fennek
Hallo,
Du kopierst Zelle für Zelle, da ist Excel sehr langsam.
Versuche möglichst große Bereiche, z.B. Spalten auf einmal zu kopieren.
Extrem schnell ist es, den gesamten Bereich in ein Array zu schreiben( Ar = Range("A1:F9999"), dort zu rechnen und das Array auf einmal zurück zu schreiben. Damit sollte deine Aufgaben nicht länger als 1 Sekunden benötigen.
mfg
AW: Makro braucht ewig .. OH,- etwas entdeckt ..
14.04.2022 13:37:03
Fred
Hallo,
Sheet Unikate mit formatierter Tabelle tb_Unikate
Beginn A4 (Titel)
zu vergleichende Werte: in Spalte A
zu übermittelnde Werte: in Spalten U:V
Sheet Tagesliste mit formatierter Tabelle tb_Tagesliste
Beginn A7 (Titel)
zu vergleichende Werte: in Spalte A
einzufügende Werte: in Spalten Y:Z
Ich hatte nicht erwähnt (weil ich es als nichtig betrachtete), das die Tabelle tb_Tagesliste im Sheet Tagesliste von den Spalte A bis Spalte GU gefüllt ist.
Wenn ich nun in Sheet Tagesliste die Spalten nach Sp Z lösche (also AA bis Sp GU), dann läuft das Makro keine 5 Min bis zum Endergebnis.
Nun möchte ich ja nicht jedesmal die Tabell tb_Tagesliste splitten und anschließend zusammenführen.
Kann im Makro entsprechend geändert/ergänzt werden?

Sub Ergebnisse1()
Dim lngZeile As Long
Dim lngSpalteMax As Long
Dim lngZeileMax As Long
Dim lngSpalte As Long
Dim lngZeileMax2 As Long
Dim VarDat As Variant
Dim i As Long
Dim sQuellSpalte As String
Dim sZielSpalte As String
Dim lngQuellZeile As Long
Dim lngQuellSpalte As Long
Dim lngZielZeile As Long
Dim lngZielSpalte As Long
Application.ScreenUpdating = False
LZ_UnikateClear2 = ThisWorkbook.Sheets("Tagesliste").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Tagesliste").Range("Y8:Z" & LZ_UnikateClear2).ClearContents
With Sheets("Unikate")
'Ermittel die letzte beschriebene Zeile in Spalte A "unikate" und speichere den Wert in Variable lngZeileMax
lngZeileMax = .Range("A" & .Rows.Count).End(xlUp).Row
'Ermittel die Anzahl der beschriebenen Spalten in "unikate" und speichere den Wert in Variable lngSpalteMax
lngSpalteMax = .UsedRange.SpecialCells(xlCellTypeLastCell).Column  ' minus 1 weil letzte Spalte eine Hilfsspalte ist
'Ermittel die letzte beschriebene Zelle in Spalte A "Tagesliste" und speichere den Wert in Variable lngZeileMax2
lngZeileMax2 = Sheets("Tagesliste").Range("A" & .Rows.Count).End(xlUp).Row
'Schleife zum durchsuchen der Zeilen von Zeile 5 beginnend bis zur letzten beschriebenen Zeile in Spalte A
For lngZeile = 5 To lngZeileMax
'Definiere Suchbereich der Schleife
VarDat = Sheets("Tagesliste").Range("A2:A" & lngZeileMax2)
'Pruefe nun Zeile fuer Zeile im definierten Suchbereich VarDat
For i = 1 To UBound(VarDat)
'Wenn der Wert in der Zeile "Live" = Wert in der Zeile "import"
If .Range("A" & lngZeile).Value = VarDat(i, 1) Then
'dann starte neue Schleife und beginne mit Uebertrag der Daten in die Zielzeile und Zielspalte
For lngSpalte = 21 To (lngSpalteMax + 0) ' kopiert ab Spalte
lngQuellZeile = lngZeile
lngQuellSpalte = lngSpalte
lngZielZeile = i + 1
lngZielSpalte = lngQuellSpalte + 4 ' fügt ein ab Spalte
'Übertrage Daten in die Spalten
Sheets("Tagesliste").Cells(lngZielZeile, lngZielSpalte).Value = .Cells(lngQuellZeile, lngQuellSpalte).Value
Next lngSpalte
End If
Next i
Next lngZeile
End With
Application.CutCopyMode = False
End Sub
Gruss
Fred
Anzeige
.. niemand eine Idee ...
14.04.2022 15:22:48
Fred
... wie das Script umgeschrieben werden könnte?
Gruss
Fred
AW: Makro braucht ewig ..
14.04.2022 16:50:02
Oberschlumpf
Hi !
Wieso zeigst du nicht per Upload eine Bsp-Datei, die genau in den gleichen Zeilen/Spalten Daten enthält wie dein Original?
(vor allem! Du bist nich erst seit gestern hier. Auch du hast bestimmt schon öfter gelesen, dass man mit Bsp-Datei vom Fragenden viel besser testen kann als nur mit Erklärungen, die auch nich immer genau das beschreiben was Sache is)
Hätte nach deiner 1. Anfrage schon jemand sein Glück versucht, einen Code für dich zu entwickeln, dann hätte der sich vielleicht heftig in den Ar*** gebissen - nachdem du...HUCH! in einem späteren Beitrag davon erzählst, dass du da etwas vergessen hattest zu erwähnen, bzw dieses erst später entdeckt hattest.
Dein gezeigter Code mag "sauber" aussehen, aber ohne Bsp-Datei mit DAten zum Testen = ?
Ciao
Thorsten
Anzeige
AW: Makro braucht ewig ..
14.04.2022 17:51:14
Fred
Hallo Thorsten,
du hast natürlich recht!
Eine Beispielmappe verdeutlicht immer das genannte Problem und hilft zum Lösungsansatz.
Ich lade sonst auch immer eine Mappe zu meinen Anfragen hoch. Diesmal dachte ich eher an eine Änderung des gut dokumentierten VBA-Code,- das es nur an einer Kleinigkeit (für einen Excel Profi) liegt...
zu faul war ich auf keinen Fall ...
Ich nehme deinen Hinweis natürlich ernst und werde in Zukunft eine Beispielmappe uploaden.
Viele Grüße
Fred
AW: Makro braucht ewig ..
14.04.2022 17:00:43
GerdL
Moin Fred,
teste mal.

Sub Unit()
Dim U As Long, T As Long, varListe As Variant, varUnikate As Variant
With ThisWorkbook
With .Sheets("Tagesliste")
.Range("Y8:Z" & .Cells(.RowRows.Count, 1).End(xlUp).Row).ClearContents
varListe = .Range("A8:Z" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
End With
With .Sheets("Unikate")
varUnikate = .Range("A5:V" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
End With
For T = 1 To UBound(varListe)
For U = 1 To UBound(varUnikate)
If varUnikate(U, 1)  "" Then
If varListe(T, 1) = varUnikate(U, 1) Then
varListe(T, 25) = varUnikate(U, 21)
varListe(T, 26) = varUnikate(U, 22)
End If
End If
Next U
Next T
With .Sheets("Tagesliste")
.Range("A8:Z" & .Range("A" & .Rows.Count).End(xlUp).Row) = varListe
End With
End With
End Sub
Gruß Gerd
Anzeige
Makro braucht ewig ./ nun fantastisch, GerdL
14.04.2022 17:51:25
Fred
Hallo Gerd,
Sheet Unikate, 900 DS
Sheet Tagesliste, 17000 DS
Anstatt über 1,5 Std
nun 2-3 Sekunden
VIELEN DANK für deine kompetente Unterstützung!!!!
Gruss
Fred
AW: Makro braucht ewig ..
14.04.2022 22:12:51
snb
Schon versucht ?

Sub M_snb
Sheet1.usedrange.offset(4).advancedfilter 2, , Sheet2.cells(1),true
End Sub

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige