Excel VBA复制在另一个独一无二的列中

我一直试图解决这个问题几天，一直无法想出或find类似的解决scheme。 我试图突出重复在一个列中，他们是不同的值在另一个。

例如偶尔在列G中有重复的名称，但是只有在值列D是唯一的时候才需要标记（突出显示）。 因此，使用下面的例子，最终的结果应该只是突出伊丽莎白摩尔。

Column D Column G 116023339 Alan Fluder 116023339 Alan Fluder 116023347 Elizabeth Moore 116025757 Elizabeth Moore 116025048 A. Lavoie 

如果它帮助下面是我用作我的起点的代码。

 Sub test() Dim cel As Variant Dim myCell As Variant Dim myrng As Range Dim myRange As Range Dim CellValue As Long Set myrng = Range("G2:G" & Range("G" & Rows.Count).End(xlUp).Row) Set myRange = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row) For Each cel In myrng If Application.WorksheetFunction.CountIf(myrng, cel) > 1 Then For Each myCell In myRange If Application.WorksheetFunction.CountIf(myRange, myCell) = 1 Then myCell.Offset(0, 3).Interior.ColorIndex = 6 End If Next myCell End If Next cel End Sub 

我应该补充一点，我现在的解决scheme是分离循环，其中一列突出显示所有列G dups，然后第二个循环不突出显示列D被欺骗。

Answer 1

如果你可以使用公式@蒂姆的build议效果很好。 修复VBA：

---

 Option Explicit Sub test() Const ROW_OFFSET As Byte = 2 Dim cel As Range Dim rng1 As Range Dim rng2 As Range Dim cRow As Long Dim lRow As Long Set rng1 = Range("G" & ROW_OFFSET & ":G" & Range("G" & Rows.Count).End(xlUp).Row) Set rng2 = Range("D" & ROW_OFFSET & ":D" & Range("D" & Rows.Count).End(xlUp).Row) With Application.WorksheetFunction For Each cel In rng1 If .CountIf(rng1, cel) > 1 Then If .CountIf(rng2, rng2.Cells(cel.Row - (ROW_OFFSET - 1), 1)) = 1 Then cel.Interior.ColorIndex = 6 End If End If Next cel End With End Sub 

---

如果列同步，则不需要使用内部For

我使用ROW_OFFSET常量来强调列之间的alignment

。