Excel VBA – 匹配2列和删除重复2张
这个棘手的问题在这里，我想。 或者我错过了一个简化它的function:)
我有一个电子表格2张。 一月和二月我只关心第一和第二列的比较。 这里是我需要发生的事情的例子。
--- Jan --- results Date/Time column 3 column 4 test Date/Time1 column 3 column 4 another_row Date/Time column 3 column 4 --- Feb --- test Date/Time1 column 3 column 4 test Date/Time2 column 3 column 4 test Date/Time3 column 3 column 4 another_row Date/Time2 column 3 column 4 results Date/Time2 column 3 column 4 预期输出 – 重复删除，但单数列的2月版本仍然存在
test Date/Time1 column 3 column 4 another_row Date/Time2 column 3 column 4 results Date/Time2 column 3 column 4
Feb将包含上面完全相同的条目以及另外24个“test”作为第1列的重复行，而第2列将包含不同的Date / Time。
我只想保留这两张纸之间常见的行值。 所以Jan的那一行是我想在二月保留的那一行，同时删除了其他二十四行。
所以，对于Jan Sheet中的每一行，我需要search第一列的值以便在表格Sheet中进行匹配，如果匹配，则比较第二列。如果两者匹配，我想保留它。 如果没有，请删除它。
另外一个警告，每个值都没有重复。 所以我只想执行这个删除，如果有重复的话。 任何独特的奇异值，我想保留。 他们可能有不同的第2列（时间/date），但如果第1列值是单数，它应该保持。
这可以在VBA中完成吗？
这是我试图find并删除重复项。 我甚至还没有得到独特的价值情况。 这可能不是我最好的办法，但这是我最近的一个。 我试图设置一个标志为true / false，然后如果两个标志都是False，就应该删除它。 就像我说的，这不能满足我独特的价值要求。 但我希望至less有它删除了24个副本，并保持我需要的1个值。
Private Sub CommandButton1_Click() Dim lRow As Long Dim lRow2 As Long Dim cell As Range Dim cell2 As Range Dim nameBool As Boolean Dim originatedBool As Boolean Dim rDel As Range Sheets("Jan").Select lRow = Range("A" & Rows.Count).End(xlUp).Row lRow2 = Range("B" & Rows.Count).End(xlUp).Row Range("A2").Select Do Until IsEmpty(ActiveCell) For Each cell In Range("A2:A" & lRow) 'Assuming you have a 1 row header If cell.Value = Sheets("Feb").Cells(cell.Row, "A") Then 'Sheets("Feb").Cells(cell.Row, "A").ClearContents nameBool = True Else nameBool = False End If Next cell For Each cell2 In Range("B2:B" & lRow2) If cell2.Value = Sheets("Feb").Cells(cell2.Row, "B") Then originatedBool = True Else originatedBool = False End If Next cell2 If nameBool = False Or originatedBool = False Then 'Debug.Print "Deleted" End If 'rDel.EntireRow.Delete ActiveCell.Offset(1, 0).Select Loop End Sub
要做到这一点，没有无限循环，只需让“Excel公式”计算你需要的一切：
Option Explicit Sub Macro1() Dim cal As Variant, i As Long, delRng As Range, LR_Cnt As Long, shtKeep As String, shtDel As String shtKeep = "Sheet1" shtDel = "Sheet2" LR_Cnt = Sheets(shtDel).Range("A" & Rows.Count).End(xlUp).Row cal = Evaluate("IF(COUNTIFS('" & shtKeep & "'!A:A,'" & shtDel & "'!A2:A" & LR_Cnt & ",'" & shtKeep & "'!B:B,""<>""&'" & shtDel & "'!B2:B" & LR_Cnt & "),ROW(2:" & LR_Cnt & "))") LR_Cnt = Application.Count(cal) If LR_Cnt > 0 Then Set delRng = Sheets(shtDel).Rows(Application.Min(cal)) If LR_Cnt > 1 Then For i = 2 To LR_Cnt Set delRng = Union(delRng, Sheets(shtDel).Rows(Application.Small(cal, i))) Next End If delRng.EntireRow.Delete End If End Sub
COUNTIFS将输出一个数组，其中包含COUNTIFS所有行号，并在shtKeep列A中匹配，但在列B中不匹配。请记住：我假设列A中没有双精度型的shtKeep ，列中的值不同B.在这种情况下， cal线需要更改
cal = Evaluate("IF(COUNTIFS('" & shtKeep & "'!A:A,'" & shtDel & "'!A2:A" & LR_Cnt & ",'" & shtKeep & "'!B:B,""<>""&'" & shtDel & "'!B2:B" & LR_Cnt & "),ROW(2:" & LR_Cnt & "))")
至
cal = Evaluate("IF(COUNTIFS('" & shtKeep & "'!A:A,'" & shtDel & "'!A2:A" & LR_Cnt & ",'" & shtKeep & "'!B:B,""<>""&'" & shtDel & "'!B2:B" & LR_Cnt & ")*(COUNTIFS('" & shtKeep & "'!A:A,'" & shtDel & "'!A2:A" & LR_Cnt & ",'" & shtKeep & "'!B:B,'" & shtDel & "'!B2:B" & LR_Cnt & ")=0),ROW(2:" & LR_Cnt & "))")
虽然第二个公式在这两种情况下都可以工作，但计算起来可能需要更长的时间（取决于要检查的shtDel中的行数）。
你唯一需要循环的时候是去所有要删除的行。 但是这只是收集数字，所以你可以删除所有行在一步更快;）
如果你有问题，就问吧。
我会像下面一样嵌套循环。
Private Sub CommandButton1_Click() Dim lRow As Long Dim lRow2 As Long Dim cell As Range Dim cell2 As Range Dim nameBool As Boolean Dim originatedBool As Boolean Dim rDel As Range with Sheets("Jan") lRow = .Range("A" & Rows.Count).End(xlUp).Row lRow2 = .Range("B" & Rows.Count).End(xlUp).Row end with For Each cell In sheets("Jan").Range("A2:A" & lRow) 'Assuming you have a 1 row header for each cell2 in sheets("Feb").range("A2:A" & lrow2) If cell.Value = cell2.value then If cell.offset(0,1) = cell2.offset(0,1) then 'keep exit for Else 'delete exit for End If End If Next cell2 Next cell End Sub