Выделение дубликатов столбцов по столбцу

Question

Я пытаюсь пройти через столбцы и выделить дубликаты внутри столбцов. Я использовал макрос записи, чтобы получить представление о том, что мне нужно, но я не уверен, как применить это во многих столбцах. Выделение всех столбцов не будет работать, потому что многие из них повторяются. Мне нужно выяснить, повторяется ли повторение несколько раз в списке.

Это код, который я до сих пор:

Sub findDuplicates() 
    Application.Goto Reference:="R3C18:R89C18" 

    Application.Goto Reference:="R3C18:R88C18" 
    Selection.FormatConditions.AddUniqueValues 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    Selection.FormatConditions(1).DupeUnique = xlDuplicate 
    With Selection.FormatConditions(1).Font 
     .Color = -16751204 
     .TintAndShade = 0 
    End With 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .Color = 10284031 
     .TintAndShade = 0 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
    Range("R21").Select 
End Sub 

Это код у меня есть, что проходит через каждую колонку в моем диапазоне от B3: OA3 и сортов по цвету и алфавиту. Мое мышление состоит в том, что, поскольку этот код идет по столбцу и сортировке, я мог бы просто добавить его, чтобы выделить дубликаты в столбце, который он уже сортировал. Но я не уверен, как бы я это сделал.

Sub sortColorThenAlpha() 
'sort by color then by alphabet 

    Dim rngFirstRow As Range 
    Dim rng As Range, rngSort As Range 
    Dim ws As Worksheet 

    Application.ScreenUpdating = False 
    Set ws = ActiveSheet 
    Set rngFirstRow = ws.Range("B3:OA3") 
    For Each rng In rngFirstRow.Cells 
     With ws.Sort 

      Set rngSort = rng.Resize(86, 1) 'to row 88 

      .SortFields.Clear 
      .SortFields.Add(rng, xlSortOnCellColor, xlAscending, , xlSortNormal). _ 
          SortOnValue.Color = RGB(198, 239, 206) 
      .SortFields.Add Key:=rng, SortOn:=xlSortOnValues, _ 
          Order:=xlAscending, DataOption:=xlSortNormal 
      .SetRange rngSort 
      .Header = xlNo 
      .MatchCase = False 
      .Orientation = xlTopToBottom 
      .SortMethod = xlPinYin 
      .Apply 

     End With 
    Next rng 
    Application.ScreenUpdating = True 
End Sub 

Это то, на что я смотрю. Это желтое conditinal форматирования, что я пытаюсь применить к каждой колонке между рядами 3 и 88.

Answer 1

не кажется VBA необходим, как условное форматирование со следующими правилами, кажется, работает:

=A1=VLOOKUP(A1,A2:A$99,1,FALSE) Applies to: =$A$1:$J$99 
=A2=VLOOKUP(A2,A$1:A1,1,FALSE) Applies to: =$A$2:$J$99 

с ориентированные на нужды.

Answer 2

Если я правильно понял ваш вопрос, вы хотите, чтобы выделить дубликаты в одном столбце, и вы хотите, чтобы иметь возможность автоматически применять это форматирование ко всем столбцам на данном листе. Поэтому, если Клеопатра появится один раз в нескольких столбцах, она не будет подсвечена, но если она появится более одного раза в одном столбце, она будет.

Следующий код делает именно это. Я нахожу, что последний столбец путем поиска значения в строке 3.

Sub HighlightDupesOneColumnAtATime() 
    Dim ws As Worksheet 
    Dim myColumn As Long 
    Dim i As Integer 
    Dim columnCount As Long 
    Dim lastRow As Long 
    Dim dupeColor As Long 

    Set ws = ThisWorkbook.Sheets("Sheet1") 
    columnCount = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column 

    dupeColor = 9944516 

    For i = 1 To columnCount 
     lastRow = ws.Cells(ws.Rows.Count, i).End(xlUp).Row 
     Call HighlightDupesInRange(dupeColor, Cells(1, i).Resize(lastRow, 1)) 
     ' it is easy to change the color of the 
     ' highlighted duplicates if you want 
     dupeColor = dupeColor + 15 
    Next i 
End Sub 

Sub HighlightDupesInRange(cellColor As Long, rng As Range) 
    With rng 
     .FormatConditions.Delete 
     .FormatConditions.AddUniqueValues 
     .FormatConditions(1).DupeUnique = xlDuplicate 
     .FormatConditions(1).Interior.Color = cellColor 
     .FormatConditions(1).StopIfTrue = False 
    End With 
End Sub