Question

每次有人更改其他工作表中的单元格时，我都会填充一份日志表。日志有6列反映“用户名”，“工作表名称”，“单元格已更改：地址”，“旧值”，“新值”，“日期和时间”（确实以宏运行）。
为了使这个日志表易于用于主管，我的想法是将那些在“工作表名称”和“单元格更改：地址”中同时具有重复项的行填充红色，但具有不同的“用户名“（这意味着其他用户对他或她未创建的内容进行了更改），并将这些行填充为黄色，这些行也会在用户列中重复，这意味着同一用户更改了自己创建的内容（”用户名“ “，”工作表名称“，”单元格已更改：地址“）。
由于Log中会有很多条目，并且随着时间的推移会有新条目，因此使用条件格式是不明智的。请不要建议这个，它不适合（大而慢的文件）。
对于VBA我认为我可以使用条件，如果说C列不为空并且同时在C＆amp; B内有重复那么如果在C＆amp; B＆amp; A中有重复A =红色（真）OR黄色（假）。

我试着一步一步走。我设法在一列中找到重复项并将其填充为黄色。我从here了解到：

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

我以为我可以以某种方式“连接”列的行并找到范围内的重复项，如上例所示，它将被包装到条件中。但是，我决定使用Union，我现在明白这是胡说八道？我首先尝试连接C＆amp; B（同时避开End（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就此工作了，但是当我试图将它作为一个范围来查找重复内容时，我陷入了困境：

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快速处理解决方案。

Answer 1

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

目前我可以想到另一种使用COUNTIFS函数基于多列搜索重复项的方法，但这要慢得多。以下是基于两列的示例：

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

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

Answer 2

这是我的建议：
找到重复的行，首先按col排序。 B，C，d。然后，副本将在相邻的行中不需要连接单元格值，只需要具有多个条件的IF 要恢复原始顺序，请插入包含原始行号的辅助列，并在处理后按其排序。您可能需要将列号（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

如何连接列并查找重复内容？

2 个答案: