Макрос VBA для сравнения столбцов в Excel и отображения различий в третьем столбце

Question

Я хочу создать кнопку макроса для сравнения столбца A и столбца B в Excel, с любыми различиями, перечисленными в столбце C.

• Я хочу, чтобы все значения в A отсутствовали вB для отображения в C
• Я хочу, чтобы все значения в B, которые не находятся в A, также отображались в C.
• Я хочу иметь возможность делать это независимо от того, какие данные помещены в Aили Б.

Answer 1

Создайте панель инструментов с кнопкой на ней, которая запускает Sub SelectionCompare. Выделите 2 столбца, в которых есть данные, и нажмите кнопку. Blam!

Вы можете настроить этот код для улучшения обработки пробелов, заголовков строк, дубликатов, обнаружения неправильных условий запуска (например, отсутствия выделения или выбора неправильного размера) или обнаружения / предотвращения перезаписи данных в выходном столбце.

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