Live-Forum - Die aktuellen Beiträge
Datum
Titel
30.04.2024 21:27:28
Bei Autofilter immer leere Zeilen einschließen
30.04.2024 20:46:46
Dopplungen Markieren, nur wenn die Zelle nebenan ident. ist
30.04.2024 20:14:55
Datum filtern
30.04.2024 19:41:34
VBA: Zellinhalt wird nicht angezeigt
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1920to1924
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1920to1924
1920to1924
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro schneller ausführen?

Makro schneller ausführen?
17.02.2023 12:14:47
Chris
Hallo zusammen,
per unten stehendem Makro durchsucht Excel Einträge in 5 Sheets nach dem Inhalt "KD" in Spalte Q und listet die gefundenen Werte untereinander auf. Das Makro funktioniert prima. Da es sich um ca. 150 - 200 Werte handelt, braucht das Makro einige Zeit bis die Werte aufgelistet wurden.
Besteht die Möglichkeit, das Makro zu beschleunigen?
Gruß
Chris


Dim wsi As Long, lng As Long
xSh = 2
For wsi = 1 To 5
lng = Sheets(wsi).Cells(Rows.Count, 10).End(xlUp).Row
For i = 3 To lng
         If Sheets(wsi).Cells(i, 17) = "KD" Then
         Sheets(wsi).Cells(i, 17).Offset(, -12).Resize(, 9).Copy
         Sheets("Auswertung").Cells(xSh, 43).PasteSpecial xlPasteValues       
         Sheets("Auswertung").Cells(xSh, 52).Value = "AW"        
         xSh = xSh+ 1
         End If
     Next i
Next wsi

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro schneller ausführen?
17.02.2023 12:29:11
Rudi
Hallo,
du könntest die Sheets nach Q sortieren und dann die Daten blockweise kopieren. Das geht erheblich schneller.
Als hinweis:
erstezeile=application.match("KD",columns(17),0)
anzahl=application.countif(columns(17),"KD")
cells(erstezeile,5).resize(anzahl,9).copy
Gruß
Rudi
AW: Makro schneller ausführen?
17.02.2023 12:36:08
captainkeksxx
Hi Chris,
wenn man die Einträge in ein Array packt und dann das Array durchsucht, das geht wesentlich schneller. Du kannst dein ganzen zu durchsuchenden Bereich in ein Array packen und diesen dann durchsuchen und dir die Position ausgeben lassen. Da kann aus einem Vorgang der 1minute Dauert, durch Arrays 1sekunde werden.
Grüße Mo
Anzeige
AW: Makro schneller ausführen?
17.02.2023 12:54:01
ChrisL
Hi
Ergänzung zu VBA: ScreenUpdating und automatische Formel-Neuberechnung könnte man auch noch deaktivieren.
Ich würde dir empfehlen aus den 5 Quellen "intelligente Tabellen" zu machen und die Daten per Power-Query einzusammeln.
https://www.youtube.com/watch?v=z3PXGn19nfI 
let
    Quelle = Excel.CurrentWorkbook(),
    #"Gefilterte Zeilen1" = Table.SelectRows(Quelle, each ([Name] > "Auswertung")),
    #"Erweiterte Content" = Table.ExpandTableColumn(#"Gefilterte Zeilen1", "Content", {"SpalteE", "SpalteF", "SpalteG", "SpalteH", "SpalteI", "SpalteJ", "SpalteK", "SpalteL", "SpalteM", "SpalteN", "SpalteO", "SpalteP", "SpalteQ"}, {"SpalteE", "SpalteF", "SpalteG", "SpalteH", "SpalteI", "SpalteJ", "SpalteK", "SpalteL", "SpalteM", "SpalteN", "SpalteO", "SpalteP", "SpalteQ"}),
    #"Gefilterte Zeilen" = Table.SelectRows(#"Erweiterte Content", each ([SpalteQ] = "KD")),
    #"Entfernte Spalten" = Table.RemoveColumns(#"Gefilterte Zeilen",{"SpalteN", "SpalteO", "SpalteP", "SpalteQ", "Name"}),
    #"Hinzugefügte benutzerdefinierte Spalte" = Table.AddColumn(#"Entfernte Spalten", "neueSpalte", each "AW")
in
    #"Hinzugefügte benutzerdefinierte Spalte"
cu
Chris
Anzeige
Noch ein Gedicht*
17.02.2023 18:09:50
Yal
Hallo Chris,
(*: der 96. Geburtstag von Heinz Erhardt ist erst am Montag, aber Freitag ist Spinnertag)
Sub kopieren()
Dim i As Integer
Dim Z As Range
Dim ersteAdresse As String
Dim ZielZeile As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    ZielZeile = 2
    For i = 1 To 5
        With Worksheets(i)
            Set Z = .Columns(17).Find("KD", LookAt:=xlWohle)
            If Not Z Is Nothing Then
                ersteAdresse = Z.Address
                Do
                    Worksheets("Auswertung").Cells(ZielZeile, 43).Resize(, 9) = .Rows(Z.Row).Range("E1:M1").Value
                    Worksheets("Auswertung").Cells(ZielZeile, 52) = "AW"
                    Set Z = .Columns(17).FindNext
                    ZielZeile = ZielZeile + 1
                Loop Until Z.Address = ersteAdresse
            End If
        End With
    Next
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
VG
Yal
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige