用于比较 Excel 中的列并在第三列中显示差异的 VBA 宏
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/9147283/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA Macro to compare columns in Excel and display the differences in a third column
提问by user1190268
I'm looking to create a macro button to compare column A and column B in Excel, with any differences being listed in column C.
我正在寻找创建一个宏按钮来比较 Excel 中的 A 列和 B 列，任何差异都列在 C 列中。
- I want all values in A that are not in B to display in C
- I want all values in B that are not in A to also display in C.
- I want to be able to do this regardless of what data is put into A or B.
- 我希望 A 中所有不在 B 中的值都显示在 C 中
- 我希望 B 中所有不在 A 中的值也显示在 C 中。
- 无论将哪些数据放入 A 或 B，我都希望能够做到这一点。
回答by ErikE
Create a toolbar with a button on it that runs Sub SelectionCompare. Highlight the 2 columns that have data and click the button. Blam!
创建一个工具栏，上面有一个运行 Sub SelectionCompare 的按钮。突出显示包含数据的 2 列，然后单击按钮。该死！
You can tweak this code to get better handling for blanks, row headings, duplicates, detection of improper starting conditions (like no selection or an improperly sized selection), or detection/prevention of overwriting data in the output column.
您可以调整此代码以更好地处理空白、行标题、重复项、检测不正确的起始条件（如未选择或选择大小不正确的选择）或检测/防止覆盖输出列中的数据。
Function ClipRange(Value As Excel.Range) As Excel.Range
Set ClipRange = Application.Intersect(Value, Value.Parent.UsedRange)
End Function
Function RangeToDict(Value As Excel.Range) As Object
Dim Cell As Excel.Range
Set RangeToDict = CreateObject("Scripting.Dictionary")
For Each Cell In Value
If Not RangeToDict.Exists(Cell.Value) Then
RangeToDict.Add Cell.Value, 1
End If
Next
End Function
Sub ColumnCompare(Column1 As Excel.Range, Column2 As Excel.Range, OutputColumn As Excel.Range)
Dim Dict1 As Object
Dim Dict2 As Object
Dim Cell As Excel.Range
Dim Key As Variant
Set Dict1 = RangeToDict(ClipRange(Column1))
Set Dict2 = RangeToDict(ClipRange(Column2))
Set Cell = OutputColumn.Cells(1, 1)
For Each Key In Dict1
If Not Dict2.Exists(Key) Then
Cell.Value = Key
Set Cell = Cell.Offset(1, 0)
End If
Next
For Each Key In Dict2
If Not Dict1.Exists(Key) Then
Cell.Value = Key
Set Cell = Cell.Offset(1, 0)
End If
Next
End Sub
Sub SelectionCompare()
ColumnCompare Selection.Columns(1), Selection.Columns(2), Selection.Columns(2).Offset(0, 1)
End Sub
