突出显示重复行 - 整行与整行 [英] Highlight Duplicate Rows - Entire Row vs Entire Row

问题描述

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

再次，我的范围是x.Range（ A4：R380\" ）。查看如何识别整个重复的行;不是基于单个列或值等等。一行中的所有列。任何帮助是赞赏。这更像是一种学习体验。 Office 2010和Office 2011（Mac）

 设置rngCl = mySheet.Range（A4：R+ CStr（LastRd）） 
设置wf = Application.WorksheetFunction 
 
对于i = 4 To LastRd 
设置cl = rngCl.Rows（i）.EntireRow 
如果wf.CountIf（rngCl， cl.Value）> 1然后
 MsgBoxfound
带有cl.Interior 
 .Pattern = xlSolid 
 .PatternThemeColor = xlThemeColorAccent1 
 .Color = 65535 
 .TintAndShade = 0 
 .PatternTintAndShade = 0.799981688894314 
结束与
与cl.Font 
 .Color = -16776961 
 .TintAndShade = 0 
 .Bold = True 
结束
结束如果
下一个i 
 
结束Sub 
 
 
 
 Sub DuplicateValue（）
 Dim值作为范围，iX As Integer 
'设置范围（更改工作表和范围以覆盖输入客舱的位置
设置值= Sheet6.Range（A4：R389）
 con = 0 
 con1 = 0 
'检查第一个工作表
对于iX = Values.Rows.Coun t到1步-1 
如果WorksheetFunction.CountIf（值，单元格（iX，1）.Value）> 1然后
 con = con + 1 
'MsgBoxStateroom&细胞（iX，1）。地址& 已经发布了一个iPad !!，vbCritical 
'Cells（iX，1）.ClearContents 
 End If 
如果WorksheetFunction.CountIf（Values，Cells（iX，3）.Value ）> 1然后
 con1 = con1 + 1 
'MsgBox这个iPAD已经被发出!!，vbCritical 
'Cells（iX，3）.ClearContents 
 End If 
 Next iX 
 
 MsgBox CStr（con）+：+ CStr（con1）
 End Sub 
  

解决方案

早上好运动！ ; - ）

这是我想出的：

 选项显式
 
 Sub HighlightDuplicates（）
 Dim colRowCount As Object 
 
 Dim lo As ListObject 
 Dim objListRow As ListRow，rngRow As Range 
 Dim strSummary As String 
 
设置colRowCount = CreateObject（Scripting.Dictionary）
 
设置lo = Sheet1.ListObjects（1）
 
'计数出现的唯一行
对于每个objListRow在lo.ListRows 
 strSummary = GetSummary（objListRow.Range）
 colRowCount（strSummary）= colRowCount（strSummary）+ 1 
下一个
 
'颜色代码行
对于每个objListRow在lo.ListRows 
中设置rngRow = objListRow.Range 
如果colRowCout（GetSummary（rngRow））> 1然后
 rngRow.Interior.Color = RGB（255，0，0）
 Else 
 rngRow.Interior.ColorIndex = RGB（0，0，0）
 End If 
下一个
 
 End Sub 
 
函数GetSummary（rngRow As Range）As String 
 GetSummary = Join（Application.Transpose（Application.Transpose（_ 
 rngRow.Value）），vbNullChar）
结束函数
  

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

可能会进一步优化（例如，通过将摘要存储在一个数组），但应该是一个很好的开始。

I cant believe how difficult this has been. I want to find all duplicate rows. Columns A:R, dynamic row count. I know how to delete the rows. But I just want to highlight them. My data is in a listobject (table) if that helps. NO! I do not want to use conditional formatting. I have already done that. It works. People always want examples, but I have re-written this so many times, here are the last two I have tried:

Again, my range is x.Range("A4:R380"). Looking how to identify duplicate rows as a whole; not based on a single column or value, etc. All columns in a row. Any help is appreciated. This is more of a learning experience than anything. Office 2010 and 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

解决方案

Nice morning exercise! ;-)

Here's what I came up with:

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

This will store the count of each unique row in a dictionary - and then check for each row if the count is larger than 1.

Can probably be optimized further (e.g. by storing the summary sting in an array), but should be a good start.

这篇关于突出显示重复行 - 整行与整行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！