☰

Kann ich dieses Makro schneller ausführen?

tag-icon • tag-icon microsoft-excel vba macros
Kann ich dieses Makro schneller ausführen?

Ich verwende dieses Makro für über 1000 Einträge. Der Code selbst funktioniert wie gewünscht.

Option Explicit
Sub DoTheThing()
 Dim keepValueCol As String
 keepValueCol = "H"

 Dim row As Integer
 row = 2

 Dim keepValueRow As Integer
 keepValueRow = 1

 Do While (Range("E" & row).Value <> "")

    Do While (Range(keepValueCol & keepValueRow).Value <> "")

    Range("E" & row).Value = Replace(Range("E" & row).Value, Range(keepValueCol & keepValueRow).Value, "")
    Range("E" & row).Value = Trim(Replace(Range("E" & row).Value, "  ", " "))

    keepValueRow = keepValueRow + 1
    Loop


 keepValueRow = 1
 row = row + 1
 Loop

End Sub

Mein Problem besteht darin, dass die Ausführung des Makros ewig dauert. Damit Sie sich das vorstellen können: Dieses Makro läuft seit 4 Stunden bei über 1.000 Einträgen und ich weiß nicht, wann es endet.

Gibt es eine Möglichkeit, diesen Code zu optimieren, damit er schneller ausgeführt wird, ohne die Integrität des Codes selbst zu beeinträchtigen?

Für jede Hilfe ist wir dankbar.

Antwort1

Wenn ich Sie richtig verstehe, möchten Sie alle Werte in Spalte H nehmen und aus Spalte E löschen? Ich würde das mit einigen Arrays machen, um es zu beschleunigen -

Option Explicit
Sub DoTheThing()
Application.ScreenUpdating = False
Dim lastrow As Integer
'Find last row in column H to size our array
lastrow = ActiveSheet.Cells(Rows.Count, "H").End(xlUp).row

'Declare the array and then resize it to fit column H
Dim varkeep() As Variant
ReDim varkeep(lastrow - 1)

'Load column H into the array
Dim i As Integer
For i = 0 To lastrow - 1
    varkeep(i) = Range("H" & i + 1)
Next

Dim member As Variant
'find last row in column E
lastrow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).row

'loop each cell in column E starting in row 2 ending in lastrow
For i = 2 To lastrow
    'Make a new array
    Dim myArray As Variant
    'Load the cell into the array
    myArray = Split(Cells(i, 5), " ")
    Dim k As Integer
    'for each member of this array
    For k = LBound(myArray) To UBound(myArray)
        member = myArray(k)
        'call the contains function to check if the member exists in column H
        If Contains(varkeep, member) Then
            'if it does, set it to nothing
            myArray(k) = vbNullString
        End If
    Next
    'let's reprint the array to the cell before moving on to the next cell in column E
    Cells(i, 5) = Trim(Join(myArray, " "))
Next
Application.ScreenUpdating = True
End Sub


Function Contains(arr As Variant, m As Variant) As Boolean
    Dim tf As Boolean
    'Start as false
    tf = False
    Dim j As Integer
        'Search for the member in the keeparray
        For j = LBound(arr) To UBound(arr)
            If arr(j) = m Then
                'if it's found, TRUE
                tf = True
                Exit For
            End If
        Next j
        'Return the function as true or false for the if statement
        Contains = tf
End Function

Dadurch wird ein Array aus Spalte H erstellt. Anschließend werden alle Zellen in Spalte E durchgegangen, in ein Array zerlegt, jedes Mitglied dieses Arrays wird mit dem Keep-Array verglichen und, falls gefunden, wird das Mitglied des Arrays gelöscht. Nachdem die Zelle durchgegangen ist, wird das Array neu gedruckt, wobei die gefundenen fehlen.

Arrays sind im Allgemeinen schneller als das Vorgehen von Element zu Element, aber zusätzlich erstellen wir unsere eigene Funktion, anstatt dielangsam Find and ReplaceMethode. Das einzige Problem ist, dass die Daten möglicherweise zusätzliche Leerzeichen enthalten. Wenn das der Fall ist, können wir dafür eine schnelle Suche und Ersetzung ausführen. Ich fand es einfacher, die Mitglieder des Arrays auf nichts zu setzen, als die Größe des Arrays zu ändern und die Elemente zu verschieben.

Antwort2

Haben Sie versucht, die Berechnungen auf manuell einzustellen? (In Excel 2013)Formulas - Calculation Options - Manual

Es scheint, dass Ihre Absicht darin besteht, alle Vorkommen der Werte in Spalte „H“ aus den Werten in Spalte „E“ zu entfernen.

Haben Sie darüber nachgedacht, den Inhalt zu exportieren und ein anderes Tool als Excel zu verwenden, um die gewünschten Änderungen vorzunehmen?

Antwort3

Ihr Code aktualisiert die Werte in Spalte E, indem er alle Werte entfernt, die er in Spalte H findet. Dies geschieht jedoch sehr ineffizient, da jedes Mal nur eine Zelle betrachtet wird. Sie können viel besser vorgehen, wenn Sie den gesamten Bereich in Spalte E auf einmal verarbeiten. Auch wenn Sie nur eine einzelne Zelle betrachten, ist es einfacher, ein Range-Objekt zu verwenden, um darauf zuzugreifen, als eine Zeichenfolge für die Spalte und eine Zahl für die Zeile zu kombinieren.

Dieser Code sollte dasselbe tun wie Ihrer, aber er verarbeitet alle Werte in Spalte E auf einmal mithilfe der Methode „Replace“ des Range-Objekts (was dieselbe Funktionalität ist wie bei „Alles ersetzen“ in der Benutzeroberfläche). Dies sollte viel schneller sein.

Im ersten ReplaceAufruf unten Truegibt das letzte Argument für eine Übereinstimmung an, bei der die Groß-/Kleinschreibung beachtet wird. Wenn Sie eine Übereinstimmung ohne Berücksichtigung der Groß-/Kleinschreibung wünschen, ändern Sie dies in False.

Option Explicit
Sub DoTheThing()

  Dim UpdateRange As Range, ReplaceCell As Range, dummy As Boolean

  Set UpdateRange = Range("E2", Range("E2").End(xlDown))
  Set ReplaceCell = Range("H1")

  Do While (ReplaceCell.Value <> "")
    dummy = UpdateRange.Replace(ReplaceCell.Value, "", xlPart, , True)
    dummy = UpdateRange.Replace("  ", " ", xlPart)
    Set ReplaceCell = ReplaceCell.Offset(1, 0)
  Loop

End Sub

Antwort4

Ich komme zwar spät zur Party, möchte aber meinen Senf zu den Lösungen dazugeben.

Dieser Code sucht nach Werten in column H(8) und ersetzt sie durch Werte ""in Spalte E.

Anstatt die Spalte E Zelle für Zelle durchzugehen, nimmt es den Ersatz in der gesamten Spalte vor. Daher wird eine einzelne Schleife für die Werte in Spalte H ausgeführt.

Public Sub big_search()
Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = ThisWorkbook
Set wks = wkb.Sheets(1)
thisrow = 1
existe = True
inicio = Format(Now(), "yyyymmddhhmmss")
While existe
    ' keep in mind that the column H is the 8th
    selectionvalue = wks.Cells(thisrow, 8)
    If selectionvalue <> "" Then
        wks.Columns("E").Replace What:=selectionvalue, Replacement:="", SearchOrder:=xlByColumns, MatchCase:=True
        thisrow = thisrow + 1
    Else
        existe = False
    End If
Wend
fin = Format(Now(), "yyyymmddhhmmss")
a = MsgBox(fin - inicio & " seconds", vbOKOnly)
End Sub

verwandte Informationen