如何连接列和查找重复？

• 每当有人更改其他工作表中的单元格时，我都有一个日志工作表。 该日志有6列反映“用户名”，“表名”，“单元格更改：地址”，“旧值”，“新值”，“date和时间”（确实运行macros）。
• 为了使这个日志表对于一个主pipe来说很容易使用，我们的想法是在“表格名称”和“单元格更改：地址”中同时填写那些重复的行，但是具有不同的“用户名” （这意味着其他用户对他或她没有创build的内容进行了更改），并将这些行填入黄色，这也会在用户列中重复，这意味着同一用户更改了自创内容（“用户名”，“表格名称“，”单元格更改：地址“）。
• 由于Log中会有很多条目，并且随着时间的推移会有新的条目，所以使用条件格式并不明智。 请不要暗示这个，不适合（大而慢的文件）。
• 对于VBA，我想我可以使用条件，如果说C列不是空的，同时C和B内有重复然后如果C＆B内有重复＆A =红色（真）或黄色（假）。

• 我试图一步一步来。 我设法在一列中find重复项，并填充为黄色。 我从这里学到了 ：

  Sub sbFindDuplicatesInColumn() Dim lastRow As Long Dim matchFoundIndex As Long Dim iCntr As Long lastRow = Range("C65000").End(xlUp).Row For iCntr = 2 To lastRow If Cells(iCntr, 3) <> "" Then matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 3), Range("C:C" & lastRow), 0) If iCntr <> matchFoundIndex Then Cells(iCntr, 1).Interior.Color = vbYellow Cells(iCntr, 2).Interior.Color = vbYellow Cells(iCntr, 3).Interior.Color = vbYellow Cells(iCntr, 4).Interior.Color = vbYellow Cells(iCntr, 5).Interior.Color = vbYellow End If End If Next End Sub 

• 我想我可以以某种方式“连接”列的行，并在上面的示例范围内find重复项，这将被包装到一个条件。 但是，我决定使用我现在明白的联盟是废话？ 我第一次尝试连接C＆B（同时回避完（xlUp）态度）：

   Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng1 As Range Dim rng2 As Range Dim col2 As Range Dim col3 As Range Dim col3and2 As Range Set rng1 = Range("C:C").Find("*", [c1], , , xlByRows, xlPrevious) Set rng2 = Range("B:B").Find("*", [b1], , , xlByRows, xlPrevious) If Not rng1 Is Nothing Then Set col3 = Range([c2], Cells(rng1.Row, 3)) Set col2 = Range([b2], Cells(rng2.Row, 2)) End If Set col3and2 = Application.Union(col3, col2) End Sub 

• col3and2.Select工作在这个，但正如我试图使用它作为一个范围内find重复，我卡住了：

   Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim lastRow As Long Dim matchFoundIndex As Long Dim iCntr As Long Dim rng1 As Range Dim rng2 As Range Dim col2 As Long Dim col3 As Long Dim col3and2 As String Set rng1 = Range("C:C").Find("*", [c1], , , xlByRows, xlPrevious) Set rng2 = Range("B:B").Find("*", [b1], , , xlByRows, xlPrevious) If Not rng1 Is Nothing Then col3 = Range([c2], Cells(rng1.Row, 3)) col2 = Range([b2], Cells(rng2.Row, 2)) End If col3and2 = Application.Union(col3, col2) lastRow = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row For iCntr = 2 To lastRow matchFoundIndex = WorksheetFunction.Match(col3&col2, col3and2, 0) If iCntr <> matchFoundIndex Then Cells(iCntr, 1).Interior.Color = vbYellow End If Next iCntr End Sub 

• 我把代码搞乱了，但是我意识到对Union的态度是错误的，因为我没有正确理解这个函数。 有出路吗？ 难道我只是“硬连接”到其他列的细胞，并在那里寻找重复？ 感觉不是VBA快速处理解决scheme。

Answer 1

连接你想要在附加列中检查的值的组合可能是最快的方法。 无论如何，我不认为在这种情况下应用vba自动化有很多好处，而不是条件格式。 此外，如果这是真的很大，共享文件，Excel可能不是最好的解决scheme开始。

目前我可以想到使用COUNTIFS函数基于多列search重复项的另外一种方法，但这样做速度相当慢。 以下是基于两列的示例：

 For iCntr = 1 To lastRow If Cells(iCntr, 1) <> "" Then matchFoundIndex = WorksheetFunction.CountIfs(Range("A1:A" & lastRow), Cells(iCntr, 1), Range("B1:B" & lastRow), Cells(iCntr, 2)) If matchFoundIndex > 1 Then Cells(iCntr, 3) = "I've found one!" End If End If Next 

这与以前的版本略有不同，因为它标识所有重复项，而Match版本不会突出显示第一个“原始”值。

Answer 2

这是我的build议：
find重复的行，首先按colsorting。 B，C，d。 重复将在相邻的行中。
不需要连接单元格值，只需要一个具有多个条件的IF 。
要恢复原始顺序，请插入带有原始行号的帮助器列，并在处理完成后按其sorting。 您可能需要将列号（const seqcolumn ）调整为高于比较所需的最后一列。
为了加快速度，将整个数据复制到一个数组中并循环（只读）。 这比在工作表上工作要快得多。 因为它是只读的，所以不需要将数组复制回工作表。
在循环数组时，收集要在VBA集合中标记的所有行号。
扫描完成后，循环所有收集的行并标记表单上的行。 同时为列范围着色，而不是单个单元格。

 Sub sbFindDuplicatesInColumn() ' mark rows with duplicates in columns B and C with color; yellow if D is dup, red if not ' 2015-12-27 ' http://stackoverflow.com/questions/34475622/how-to-concatenate-columns-and-find-duplicates-within Const seqcolumn = 11 ' helper column to restore original order after sorting Dim lastRow As Long Dim table As Range Dim row As Long, markedRow As Variant Dim arr As Variant Dim lastB As Variant, lastC As Variant, lastD As Variant Dim addedPrev As Boolean Dim dupes As New Collection Application.ScreenUpdating = False Application.EnableEvents = False ' count last used row from column C lastRow = Cells(Cells.Rows.Count, 3).End(xlUp).row ' insert sequence number column to the far left = A Columns(seqcolumn).Insert For row = 2 To lastRow Cells(row, seqcolumn) = row Next row ' B&C duplicate lines, if D identical=yellow, else =red Rows("2:" & lastRow).Sort Key1:=Cells(2, 2), Order1:=xlAscending, Key2:=Cells(2, 3) _ , Order2:=xlAscending, Key3:=Cells(2, 4), Order3:=xlAscending, Header:= _ xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _ xlSortNormal Set table = Range(Cells(1, 2), Cells(lastRow, 4)) ' oldB, oldC, oldD ' reset previous marks table.Interior.ColorIndex = xlNone arr = table ' find duplicates (B and C equal); if D equal, yellow, else red lastB = arr(2, 1) lastC = arr(2, 2) lastD = arr(2, 3) addedPrev = False For row = 3 To lastRow If arr(row, 1) = lastB And arr(row, 2) = lastC Then If arr(row, 3) = lastD Then If Not addedPrev Then dupes.Add (row - 1) dupes.Add row Else If Not addedPrev Then dupes.Add -(row - 1) dupes.Add -row lastD = arr(row, 3) End If addedPrev = True Else lastB = arr(row, 1) lastC = arr(row, 2) lastD = arr(row, 3) addedPrev = False End If Next row ' mark rows For Each markedRow In dupes If markedRow > 0 Then Range(Cells(markedRow, 2), Cells(markedRow, 7)).Interior.Color = vbYellow Else Range(Cells(-markedRow, 2), Cells(-markedRow, 7)).Interior.Color = vbRed End If Next markedRow ' sort to original order Rows("2:" & lastRow).Sort Key1:=Cells(2, seqcolumn), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Columns(seqcolumn).Delete Application.EnableEvents = True Application.ScreenUpdating = True End Sub