简体   繁体   中英

VBA Macro to compare columns in Excel and display the differences in a third column

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.

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

Create a toolbar with a button on it that runs Sub SelectionCompare. Highlight the 2 columns that have data and click the button. Blam!

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM