Question

我无法相信这有多么困难。我想找到所有重复的行。列A：R，动态行数。我知道如何删除行。但我只是想强调它们。如果有帮助，我的数据在listobject（表格）中。没有！我不想使用条件格式。我已经这样做了。有用。人们总是想要一些例子，但我已经多次重写了这个，这是我尝试的最后两个：

同样，我的范围是x.Range（“A4：R380”）。了解如何识别整个重复行;不基于单个列或值等。一行中的所有列。任何帮助表示赞赏。这比任何事情都更像是一种学习经历。 Office 2010和Office 2011（Mac）

    Set rngCl = mySheet.Range("A4:R" + CStr(LastRd))
    Set wf = Application.WorksheetFunction

        For i = 4 To LastRd
        Set cl = rngCl.Rows(i).EntireRow
            If wf.CountIf(rngCl, cl.Value) > 1 Then
            MsgBox "found"
                With cl.Interior
                    .Pattern = xlSolid
                    .PatternThemeColor = xlThemeColorAccent1
                    .Color = 65535
                    .TintAndShade = 0
                    .PatternTintAndShade = 0.799981688894314
                End With
                With cl.Font
                    .Color = -16776961
                    .TintAndShade = 0
                    .Bold = True
                End With
            End If
        Next i

    End Sub



    Sub DuplicateValue()
        Dim Values As Range, iX As Integer
         'set ranges (change the worksheets and ranges to cover where the staterooms are entered
        Set Values = Sheet6.Range("A4:R389")
         con = 0
         con1 = 0
         'checking on first worksheet
        For iX = Values.Rows.Count To 1 Step -1
            If WorksheetFunction.CountIf(Values, Cells(iX, 1).Value) > 1 Then
                con = con + 1
                'MsgBox "Stateroom " & Cells(iX, 1).Address & " has already been issued an iPad!!", vbCritical
                'Cells(iX, 1).ClearContents
            End If
            If WorksheetFunction.CountIf(Values, Cells(iX, 3).Value) > 1 Then
                con1 = con1 + 1
                'MsgBox "This iPAD has already been issued!!", vbCritical
                'Cells(iX, 3).ClearContents
            End If
        Next iX

        MsgBox CStr(con) + ":" + CStr(con1)
    End Sub

Answer 1

早上好运动！ ; - ）

以下是我提出的建议：

Option Explicit

Sub HighlightDuplicates()
    Dim colRowCount As Object

    Dim lo As ListObject
    Dim objListRow As ListRow, rngRow As Range
    Dim strSummary As String

    Set colRowCount = CreateObject("Scripting.Dictionary")

    Set lo = Sheet1.ListObjects(1)

    'Count occurrence of unique rows
    For Each objListRow In lo.ListRows
        strSummary = GetSummary(objListRow.Range)
        colRowCount(strSummary) = colRowCount(strSummary) + 1
    Next

    'Color code rows
    For Each objListRow In lo.ListRows
        Set rngRow = objListRow.Range            
        If colRowCout(GetSummary(rngRow)) > 1 Then
            rngRow.Interior.Color = RGB(255, 0, 0)
        Else
            rngRow.Interior.ColorIndex = RGB(0, 0, 0)
        End If
    Next

End Sub

Function GetSummary(rngRow As Range) As String
    GetSummary = Join(Application.Transpose(Application.Transpose( _
        rngRow.Value)), vbNullChar)
End Function

这将在字典中存储每个唯一行的计数 - 然后在计数大于1时检查每一行。

可以进一步优化（例如将摘要sting存储在数组中），但应该是一个好的开始。

突出显示重复行 - 整行与整行

1 个答案: