Excel宏将所选列单元格与“下一列”单元格进行比较，如果相同则进行颜色填充

Question

我想这一定很容易做到，但我根本找不到我的 GoogleFu 帮助，而且我不了解 VBA 的对象引用指南。

我要做的是制作一个允许我选择一列的宏，然后将该列中的每个单元格逐行与右侧列中的单元格进行比较（例如 A1:B1 如果A1 被选中，F1:G1 是 F1 被选中）。我不希望一个单元格与不同列中的所有单元格（例如 A1 与 B 列中的所有单元格相比）或同一行中的所有单元格（例如 A1 与 A 行中的所有单元格相比）进行比较。

当我手动执行此操作时，我突出显示两个要查看的单元格，单击“条件格式”，按公式进行格式设置，然后输入 =x1y1（其中 x1 是我要选择的列，例如A1 或 F1，y1 是我要比较的列，例如 B1 或 G1)。

我尝试使用宏记录器，但它迫使我按 ID 指定列，而不是允许我通过鼠标选择列。如果有一种方法可以弹出一个文本框，让我输入我想要的列，那就行了。如果有办法将选定的列填充为 x1 并将其右侧的列填充为 y1，它也会起作用。我无法找到有关这两种可能性的信息。我知道 .Offset 属性存在，但我不知道它如何用于我想要的。

这是来自我的宏记录器的代码：

    Sub ColorHighlightDiscrepancies()
'
' ColorHighlightDiscrepancies Macro
' ColorHighlightDiscrepancies
'

'
    Columns("X:Y").Select
    Range("Y1").Activate
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=X1<>Y1"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 4145151
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub

下面是逐行执行的代码（可在 ExcelForum 找到），但会将一行中的所有单元格与该行中的所有其他单元格进行比较：

Sub ColorDuplicates()

  Dim Data As Variant
  Dim DSO As Object
  Dim Rng As Range

   'Assumes Row 1 has Column Headers
    Set Rng = Range("A2").CurrentRegion.Offset(1, 0)
    Data = Rng.Value

    Set DSO = CreateObject("Scripting.Dictionary")

      For I = 1 To UBound(Data, 1)
        For J = 1 To UBound(Data, 2)
          Key = Trim(Data(I, J))
          If Key <> "" Then
            If Not DSO.Exists(Key) Then
               DSO.Add Key, 1
            Else
               Rng.Cells(I, J).Interior.ColorIndex = 3
            End If
          End If
        Next J
        DSO.RemoveAll
      Next I

    Set DSO = Nothing

End Sub

Answer 1

如果有一种方法可以弹出一个文本框，让我输入我想要的列，那将有效。

还好有：

Dim rng as Range
Set rng = Application.InputBox("Select column(s)", Type:=8)

或者：

我尝试使用宏记录器，但它迫使我按 ID 指定列，而不是允许我通过鼠标选择列。

改变这个：

Columns("X:Y").Select
Range("Y1").Activate

对此（将选择当前Selection第二列的第一个单元格）：

Range(Selection.Cells(1, 2).Address).Activate