Question

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

我有一张2张电子表格。 Jan和Feb.我只关心第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

预期输出 - 重复删除，但奇异列的二月版仍为

test          Date/Time1    column 3    column 4
another_row   Date/Time2    column 3    column 4
results       Date/Time2    column 3    column 4

2月将包含上面完全相同的条目以及其他24个重复行，其中包含＆＃39; test＆＃39;作为第1列和第2列的不同日期/时间。

我想只保留两张表之间常见的行值。因此Jan中的行是我想在2月份保留的行，同时删除其他24行。

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

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

这可以在VBA中完成吗？

我试图找到并删除重复项。我还没有达到独特的价值观。这可能不是我最好的方法，但它是我的最新方法。我试图将标志设置为true / false，然后如果任一标志为False，则应将其删除。就像我说的，这并不能解决我独特的价值要求。但我希望至少删除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

要做到没有无限循环，只需让＆＃34; excel公式＆＃34;像这样计算你需要的一切：

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列中没有双打，在列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

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

2 个答案: