Excel VBA - 匹配 2 列并删除 2 张纸上的重复项

Question

我认为这里有点棘手的问题。或者我错过了一个可以简化一切的功能:)

我有一个包含 2 张纸的电子表格。一月和二月。我只关心第 1 列和第 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 列的日期/时间不同。

我只想保留两张纸之间共有的行值。所以一月的行是我想在二月保留的行，同时删除其他 24 行。

因此，对于 Jan 表中的每一行，我需要在表 Feb 中搜索第 1 列的匹配值，如果匹配，则比较第 2 列。如果两者都匹配，我想保留它。如果没有，请删除它。

另外一个警告，每个值都没有重复项。所以我只想在有重复的时候执行这个删除。我想保留任何独特的、奇异的价值观。它们可能有不同的第 2 列（时间/日期），但如果第 1 列的值是单数，则应该保留。

这可以在 VBA 中完成吗？

这是我尝试查找和删除重复项的尝试。我什至还没有达到独特的价值情况。这可能不是我最好的方法，但它是我最新的方法。我试图将标志设置为真/假，然后如果任一标志为假，则应将其删除。就像我说的，这不能满足我独特的价值要求。但我希望至少让它删除 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

Answer 1

要在没有无限循环的情况下做到这一点，只需让“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 将输出一个数组，其中包含 shtDel 的所有行号，在 shtKeep 列 A 中匹配但在 B 列中不匹配。请记住：我假设没有双精度数shtKeep 的 A 列在 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 中的行数）。

您需要循环的唯一时间是当您查找要删除的所有行时。但这只是为了收集数字，因此您可以一步删除所有行以更快;）

如果你有任何问题，尽管问。

Answer 2

我会像下面这样嵌套循环。

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