Excel VBA-匹配2列并删除2张纸上的重复项 [英] Excel VBA - Match 2 Columns and Delete duplicates on 2 sheets

问题描述

我认为这是一个棘手的问题.还是我错过了一个可以简化所有功能的功能:)

我有一个包含2张纸的电子表格.一月和二月.我只关心比较的第1列和第2列.这是我需要做的事的例子.

  ---一月---结果日期/时间第3列第4列测试日期/时间1列3列4another_row日期/时间第3列第4列-2月-测试日期/时间1列3列4测试日期/时间2列3列4测试日期/时间3列3列4another_row日期/时间2列3列4结果日期/时间2列3列4 

预期的输出-重复项已删除，但2月版本的单数列仍保留

  test Date/Time1第3列第4列another_row日期/时间2列3列4结果日期/时间2列3列4 

2月将包含与上面完全相同的条目，外加24个其他重复的行，其中"test"作为第1列，而第2列的日期/时间不同.

我只想保留两张纸之间共有的行值.因此，一月份的行是我想保留在二月份的行，同时删除了其他24个行.

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

另外请注意，每个值都没有重复项.因此，我只想在完全重复的情况下执行此删除操作.我想保留任何唯一的，奇异的值.它们可能具有不同的第2列(时间/日期)，但是如果第1列的值是单数，则应保留该值.

这可以在VBA中完成吗?

这是我尝试查找和删除重复项的尝试.我什至还没有遇到独特的价值状况.这可能不是我最好的方法，但这是我最新的方法.我试图将标志设置为true/false，然后如果其中一个标志为False，则应将其删除.就像我说的那样，这不能满足我独特的价值要求.但是我希望至少让它删除24个重复项并保留我需要的1值.

  Private Sub CommandButton1_Click()昏暗的行Dim lRow2只要长暗单元格范围昏暗的cell2作为范围昏暗的nameBool为布尔值昏暗的OrigindBool为布尔值Dim rDel作为范围Sheets("Jan").SelectlRow = Range("A"& Rows.Count).End(xlUp).RowlRow2 = Range("B"& Rows.Count).End(xlUp).Row范围("A2").选择直到IsEmpty(ActiveCell)对于Range("A2:A"& lRow)中的每个单元格'假设您有1行标题如果cell.Value = Sheets("Feb").Cells(cell.Row，"A")然后'Sheets("Feb").Cells(cell.Row，"A").ClearContentsnameBool =真别的nameBool =假万一下一个单元格对于范围内的每个单元2("B2:B"& lRow2)如果cell2.Value = Sheets("Feb").Cells(cell2.Row，"B")然后origindBool =真别的origindBool =假万一下一个单元格2如果nameBool = False或origindBool = False则'Debug.Print已删除"万一'rDel.EntireRow.DeleteActiveCell.Offset(1，0).选择环形结束子 

解决方案

要做到无止境的循环，只需让"excel公式"像这样计算所需的一切:

 选项显式子Macro1()Dimcal As Variant，i As Long，delRng As Range，LR_Cnt As Long，shtKeep as String，shtDel As StringshtKeep ="Sheet1"shtDel ="Sheet2"LR_Cnt = Sheets(shtDel).Range("A"& Rows.Count).End(xlUp).Rowcal = 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(校准)如果LR_Cnt>0然后设置delRng = Sheets(shtDel).Rows(Application.Min(cal))如果LR_Cnt>1然后对于i = 2到LR_Cnt设置delRng = Union(delRng，Sheets(shtDel).Rows(Application.Small(cal，i)))下一个万一delRng.EntireRow.Delete万一结束子 

COUNTIFS 将输出一个数组，该数组保存 shtDel 的所有行号，且在 shtKeep 列A中有匹配项，但在B列.请记住:我假设A列中的 shtKeep 没有双打，而B列中的值不同.在这种情况下， cal 行需要为更改为

  cal =评估("IF(COUNTIFS('"& shtKeep&'！A:A，'"& shtDel&'！A2:A"& LR_Cnt&，'& shtKeep&"'！B:B，"<>&'"& shtDel&"'！B2:B& LR_Cnt&")，ROW(2:& LR_Cnt&"))) 

到

  cal =评估("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 中的行数).

唯一需要循环的时间是当您要删除的所有行.但这只是为了收集数字，因此您可以一步一步删除所有行；)

如果有任何疑问，请问.

Bit of a tricky problem here, I think. Or I'm missing that one function that will simplify it all :)

I have a spreadsheet with 2 sheets. Jan and Feb. I only care about columns 1 and 2 for the comparison. Here are examples of what I need to happen.

 --- 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

Output expected - Duplicates deleted, but the Feb version of the singular columns remain

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

Feb will contain the exact same entry above plus 24 other duplicate rows with 'test' as column 1 and a different Date/Time for column 2.

I want to only keep the row values that are common between the two sheets. So the row in Jan is the one I want to keep in Feb, while deleting the 24 others.

So, for each row in the Jan sheet I need to search for the values of column 1 for a match in sheet Feb and if there is a match, compare column 2. If both are matching, I want to keep it. If not, delete it.

One other caveat, there are not duplicates of each value. So I only want to perform this removal if there are duplicates at all. Any unique, singular values, I want to keep. They may have different column 2 (time/date) but if the column 1 value is singular, it should stay.

Can this be done in VBA?

Here's my attempt to just find and delete the duplicates. I haven't even gotten to the unique value situation yet. This may not be my best approach, but it's my latest one. I attempted to set a flag to true/false and then if either flag was False, it should be deleted. Like I said, this doesn't handle my unique value requirement. But I was hoping to at least have it delete the 24 duplicates and keep the 1 value I need.

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

解决方案

To do it without endless loops, simply let the "excel formulas" calculate everything you need like this:

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

the COUNTIFS will output an array which holds all row-numbers for the shtDel with an match in shtKeep column A but no match in column B. Just keep in mind: I assumed there are no doubles in column A for shtKeep with different values in column B. In that case, the cal line needs to be changed from

cal = Evaluate("IF(COUNTIFS('" & shtKeep & "'!A:A,'" & shtDel & "'!A2:A" & LR_Cnt & ",'" & shtKeep & "'!B:B,""<>""&'" & shtDel & "'!B2:B" & LR_Cnt & "),ROW(2:" & LR_Cnt & "))")

to

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 & "))")

While the second formula would work in both cases, it may take longer to calculate (depends on the count of rows in shtDel which are to be checked).

The only time you need to loop is when you go for all the rows which are to delete. But this is only to collect the numbers so you can delete all rows in one step to be faster ;)

If you have any questions, just ask.

这篇关于Excel VBA-匹配2列并删除2张纸上的重复项的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！