excel - 比较 A 列和 B 列并创建包含仅存在于 A 列中的值的新列

Question

有几个问题提出了类似但不完全相同的问题。

我有两列 X和 Y . Y仅包含 X 中存在的值.我想创建一个列 Z具有仅存在于 X 中的所有值.

• X和 Y可以包含重复数据，如示例所示
• X存在于 sheet1同时 Y and Z存在于 sheet2

<表类="s-表"> <头> <日>X <日>是 <日>Z <正文> 一个 c 一个 b e b b d c e d e

到目前为止，我录制了一个宏，所以尽管我尽了最大努力清理它，但代码自然非常慢。我不会发布整个代码，因为它很乱，但基本上我已经

1. 使用了 unique()函数创建两个包含 X 的唯一值的列和 Y分别。

2. 二手 vlookup()创建一个与我刚刚创建的两个相邻的列，返回一个空字符串 如果相邻唯一 X值(value)存在于唯一Y其他列返回 X值(value)。这部分非常慢。我在一个单元格中创建了公式，然后将其粘贴下来。

Range("U2").Formula2R1C1 = "=UNIQUE('1.HoldingCart'!C[-18])"
Range("V2").Formula2R1C1 = "=UNIQUE(C[-19])"
Range("W3").FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-2], C[-1], 1, FALSE)), RC[-2], """")"
Range("W3").Copy
Range("W3:W" & Cells(Rows.Count, "U").End(xlUp).Row).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

1. 过滤掉 vlookup() 上的所有空字符串柱子。复制了实际值。摆脱了过滤器。删除所有内容，然后粘贴复制的数据，从而创建列 Z .

' Get the discrepancies
ActiveSheet.Range("$W:$W").AutoFilter Field:=1, Criteria1:="<>"
Range("W2:W" & Cells(Rows.Count, "W").End(xlUp).Row).Copy
Range("X2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False

' Clean the sheet
ActiveSheet.ShowAllData
Selection.AutoFilter
Range("U2:W" & Cells(Rows.Count, "W").End(xlUp).Row).ClearContents

' Paste the discrepancies
Range("X2:X" & Cells(Rows.Count, "X").End(xlUp).Row).Cut
Range("U2").Select
ActiveSheet.Paste

抱歉，您不得不阅读那些可怕的代码。我很高兴把所有这些都扔掉。任何帮助将不胜感激。

Answer 1

我看你不介意放弃VBA，但愿意改用公式。使用 microsoft365，您可以使用:

C2 中的公式

=UNIQUE(FILTER(A2:INDEX(A:A,MATCH("ZZZ",A:A)),COUNTIF(B2:INDEX(B:B,MATCH("ZZZ",B:B)),A2:INDEX(A:A,MATCH("ZZZ",A:A)))=0))

---

如果您确实想通过 VBA，那么可以使用字典。一个粗略的例子可能是:

Sub Test()

Dim LrA As Long, LrB As Long, x As Long
Dim arrA As Variant, arrB As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")

With ws
    
    'Get last used rows
    LrA = .Cells(.Rows.Count, 1).End(xlUp).Row
    LrB = .Cells(.Rows.Count, 2).End(xlUp).Row
    
    'Initialize arrays
    arrA = .Range("A2:A" & LrA).Value
    arrB = .Range("B2:B" & LrB).Value
    
    'Run over arrA and fill Dictionary
    For x = LBound(arrA) To UBound(arrA)
        dict(arrA(x, 1)) = 1
    Next
    
    'Run over arrB and remove from Dictionary
    For x = LBound(arrB) To UBound(arrB)
        If dict.Exists(arrB(x, 1)) Then dict.Remove arrB(x, 1)
    Next
    
    'Pull remainder from dictionary
    .Cells(2, 3).Resize(dict.Count).Value = dict.Keys
    
End With

End Sub