Fragen Sie nach, ob Sie dieses Makro schneller ausführen können. - Ich sende hier meine Antwort und stimme ab, um diese Frage als Duplikat zu schließen.
Wenn ich Sie verstehe, möchten Sie alle Werte in Spalte H übernehmen und aus Spalte E löschen? Ich würde das mit einigen Arrays tun, 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. Dann durchläuft es jede Zelle in Spalte E, analysiert es in ein Array, durchsucht jedes Member dieses Arrays anhand des Keep-Arrays und löscht dieses Member des Arrays, wenn es gefunden wird. Nach dem Durchlaufen der Zelle wird das Array erneut gedruckt, wobei die gefundenen fehlen.
Arrays sind im Allgemeinen schneller als gehende Elemente für Elemente, aber zusätzlich erstellen wir unsere eigene Funktion, anstatt die langsame Find and Replace Methode zu verwenden. Das einzige Problem ist, dass möglicherweise zusätzliche Leerzeichen in den Daten vorhanden sind. Wenn ja, können wir eine schnelle Suche durchführen und dafür ersetzen. Ich fand es einfacher, die Mitglieder des Arrays auf nichts zu setzen, als das Array neu zu dimensionieren und die Elemente zu verschieben.
Der Vollständigkeit halber folgt eine Routine, die zusätzliche Leerzeichen aus Spalte E entfernt
Sub ConsecSpace() Dim c As Range Dim lastrow As Integer lastrow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row Dim strValue As String For Each c In Range("E2:E" & lastrow) strValue = c.Value Do While InStr(1, strValue, " ") strValue = Replace(strValue, " ", " ") Loop c = strValue Next End Sub