3

複数の列にまたがるExcel2010の重複セルを異なる色で強調表示するにはどうすればよいですか？

このコードを見つけましたが、1つの列で機能します。

    Sub Highlight_Duplicate_Entry()
        Dim cel As Variant
        Dim myrng As Range
        Dim clr As Long
    
        Set myrng = Range("A2:A" & Range("A65536").End(xlUp).Row)
        myrng.Interior.ColorIndex = xlNone
        clr = 3

        For Each cel In myrng
           If Application.WorksheetFunction.CountIf(myrng, cel) > 1 Then
              If WorksheetFunction.CountIf(Range("A2:A" & cel.Row), cel) = 1 Then
                 cel.Interior.ColorIndex = clr
                 clr = clr + 1
              Else
                 cel.Interior.ColorIndex = myrng.Cells(WorksheetFunction.Match(cel.Value, myrng, False), 1).Interior.ColorIndex
              End If
          End If
       Next
    End Sub
4

1 に答える 1

4

複数の列をカバーするように範囲を変更する必要があります。これにより、Match関数が失敗します。に置き換えますFind。以下のサブは、指定された範囲内の重複を見つけて、異なる色で強調表示します。

コードを次のように置き換えます。

Sub Highlight_Duplicate_Entry()
    Dim ws As Worksheet
    Dim cell As Range
    Dim myrng As Range
    Dim clr As Long
    Dim lastCell As Range

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set myrng = ws.Range("A2:d" & Range("A" & ws.Rows.Count).End(xlUp).Row)
    With myrng
        Set lastCell = .Cells(.Cells.Count)
    End With
    myrng.Interior.ColorIndex = xlNone
    clr = 3

    For Each cell In myrng
        If Application.WorksheetFunction.CountIf(myrng, cell) > 1 Then
            ' addresses will match for first instance of value in range
            If myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Address = cell.Address Then
                ' set the color for this value (will be used throughout the range)
                cell.Interior.ColorIndex = clr
                clr = clr + 1
            Else
                ' if not the first instance, set color to match the first instance
                cell.Interior.ColorIndex = myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Interior.ColorIndex
            End If
        End If
    Next
End Sub

これがどのように機能するかを明確にするために、以下のコメントに基づいて結果のスクリーンショットを追加します。複製の各セットは、別々の色で強調表示されます。重複していない値は色付けされません。 ここに画像の説明を入力してください

于 2013-03-02T22:18:57.670 に答える