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

Question

我认为这是一个棘手的问题。或者我缺少一个可以简化这一切的功能:)

我有一个包含 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

二月将包含与上面完全相同的条目以及其他 24 个重复行，其中“test”作为第 1 列，第 2 列使用不同的日期/时间。

我只想保留两个工作表之间共有的行值。因此，我想在 2 月保留 1 月的行，同时删除其他 24 行。

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

另一个警告，每个值都不重复。因此，我只想在存在重复项时执行此删除操作。我想保留任何独特的、奇异的值(value)观。它们的第 2 列(时间/日期)可能不同，但如果第 1 列值是单数，则应保留。

这可以用 VBA 完成吗？

这是我尝试查找并删除重复项的尝试。我什至还没有达到独特值(value)的情况。这可能不是我最好的方法，但这是我最新的方法。我尝试将标志设置为真/假，然后如果任一标志为假，则应将其删除。就像我说的，这不能满足我独特的值(value)要求。但我希望至少让它删除 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 列。请记住:我假设 A 列中没有 shtKeep 的 double 值，而 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 中要检查的行数)。

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

如果您有任何疑问，请尽管提问。