중복 행 강조 - 행 전체 대 전체 행

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

멋진 아침 운동! - 카운트가 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 

: ;-)

여기

내가 생각 해낸거야

배열에 요약 정보를 저장하여 추가로 최적화 할 수는 있지만 좋은 시작이어야합니다.