Wiederholen Sie einen Befehl mit verschiedenen Daten in VBA - Excel, VBA, Schleifen

Ich entwickle gerade ein Excel-Makro. Wollte wissen, wie ich einige Codezeilen mit verschiedenen Daten ohne Kopieren und Einfügen wiederholen kann.

Freue mich auf deine Antworten:) Dies ist mein aktueller Code:

Sub deleteredundant()

Windows("Test1.xlsm").Activate
If Range("A6") = Range("A7") And Range("B6") = Range("B7") Then
Range("A7:B7").Select
Selection.ClearContents
End If

End Sub

Antworten:

Es klingt so, als hätte @BruceWayne Sie in die richtige Richtung für das, was Sie brauchen, gezeigt: Duplikate entfernen.

Wie @Apurv Pawar zeigt, können Sie eine Schleife verwenden, aber er wählt Zellen aus (wenn in einem Code ausgewählt wird, dass eine Zelle ausgewählt oder aktiviert werden soll, klicken Sie nicht auf ... Sie können eine Zelle referenzieren, ohne sie auszuwählen).

Eine andere Möglichkeit besteht darin, über ein Verfahren zum Entfernen der Zellen zu verfügen und ein anderes Verfahren, um anzugeben, welche Arbeitsmappe, Arbeitsblatt und Zelle angezeigt werden soll.

Sub DeleteRedundant(CheckRange As Range)

If CheckRange = CheckRange.Offset(1) And CheckRange.Offset(, 1) = CheckRange.Offset(1, 1) Then
CheckRange.Offset(1).Resize(, 2).ClearContents
End If

End Sub

Der obige Code akzeptiert einen Bereich, der an ihn übergeben wird.
Es wird geprüft, ob die übergebene Zelle der Zelle unter sich entspricht:
CheckRange = CheckRange.Offset(1)

Dann wird geprüft, ob die Zelle rechts von der übergebenen Zelle dem darunter liegenden Wert entspricht:
CheckRange.Offset(, 1) = CheckRange.Offset(1, 1)

Wenn die Werte übereinstimmen, wird die Zelle unter der übergebenen Zelle angezeigt. Ändern Sie die Größe auf zwei Zellen und löschen Sie den Inhalt dieser beiden Zellen:
CheckRange.Offset(1).Resize(, 2).ClearContents

Mit diesem Verfahren können wir verschiedene Bereichsreferenzen zur Bearbeitung übergeben:

Sub Test()

DeleteRedundant Workbooks("Excel Worksheet1.xlsx").Worksheets("Sheet1").Range("A6")
DeleteRedundant Workbooks("Excel Worksheet2.xlsx").Worksheets("Sheet2").Range("D5")

"Pass every other cell to the procedure in a loop.
"So will pass A2, A4, A6 - Cells(2,1), Cells(4,1) and Cells(6,1)
Dim x As Long
For x = 2 To 20 Step 2
DeleteRedundant Workbooks("Excel Worksheet1.xlsx").Worksheets("Sheet1").Cells(x, 1)
Next x

End Sub

Aber, wie @BruceWayne sagt - Sie benötigen wahrscheinlich nur die Schaltfläche Duplikate löschen im Datenbereich.

versuche das unten.

Sub deleteredundant()

Windows("Test1.xlsm").Activate

x = 1

Do While Range("a" & x).Formula <> ""

If Range("A" & x) = Range("A" & (x + 1)) And Range("B6" & x) = Range("B7" & (x + 1)) Then
Rows(x & ":" & x).Select
With Selection
.Delete EntireRow
End With

End If
x = x + 1
Loop

End Sub