ハイライト重複する値は、

Question

は、私はマクロコードの下で試してみましたが、そのはPlzをやろうとし

そして、もう一つのIAMを私を助けて2番目のインスタンスから重複して強調していません動的に固定範囲を取らない（特定の範囲）

Sub FindingDuolicate() 
    Dim Rng As Range 
    Dim rngCell As Variant 
    Dim Flag As Long 
    ActiveSheet.UsedRange.Select 
    Flag = 0 
    For Each Rng In Selection 
     If (WorksheetFunction.CountIf(Selection, Rng.Value) > 1) Then 
      Rng.Interior.Color = vbRed 
      Flag = Flag + 1 
     Else 
      Rng.Interior.Pattern = xlNone 
     End If 
    Next 
    If Flag > 0 Then 
     MsgBox Flag & " Cells (in red) Contain an Duplicate Data. Please Check" 
    Else 
     MsgBox " Data Validation Completed . No Duplicate Found. " 
    End If 
End Sub 

Answer 1

あなたが関数にあなたのサブを回すことができ、次のよう

Function FindingDuplicate(rng As Range, counter As Long) As Boolean 
    Dim cell As Range 

    For Each cell In rng 
     If WorksheetFunction.CountIf(Range(rng(1, 1), cell), cell.Value) > 1 Then 
      cell.Interior.Color = vbRed 
      counter = counter + 1 
     Else 
      cell.Interior.Pattern = xlNone 
     End If 
    Next 
    FindingDuplicate = counter > 0 
End Function 

はあなたの "メイン" サブによって悪用される：Long`として

Option Explicit 

Sub main() 
    Dim counter As Long 

    If FindingDuplicate(ActiveSheet.UsedRange, counter) Then '<--| change 'ActiveSheet.UsedRange' to whatever range you want 
     MsgBox counter & " cells (red background) contain a duplicated data. Please Check" 
    Else 
     MsgBox " Data Validation Completed. No Duplicate Found." 
    End If 
End Sub 

Answer 2

更新された回答。 countifを使用するのではなく、前の各セルをループして比較します。あなたが非常に広い範囲を持っている場合は遅くなるかもしれませんが、複数の列で動作します。

Sub DupsCheck() 
Dim Rng As Range 
Dim RngChecked As Range 
Dim previousRng As Range 
Dim rngCell As Variant 
Dim LR As Long 

'ActiveSheet.UsedRange.Select 
Flag = 0 

Selection.Interior.Pattern = x1None 

For Each Rng In Selection 
    If Not RngChecked Is Nothing Then 
    ' Add the 2nd, 3rd, 4th etc cell to our new range, rng2 
    ' this is the most common outcome so place it first in the IF test (faster coding) 

    For Each previousRng In RngChecked 

     If previousRng.Value = Rng.Value And Rng.Interior.Color <> vbRed Then 
     Debug.Print previousRng.Address & " " & Rng.Address 
      Rng.Interior.Color = vbRed 
      Flag = Flag + 1 

     End If 
     'Debug.Print Flag 
    Next 

     Set RngChecked = Union(RngChecked, Rng) 
    Else 
    ' the first valid cell becomes rng2 
     Set RngChecked = Rng 
    End If 

Next 
If Flag > 0 Then 
    MsgBox Flag & " Cells (in red) Contain an Duplicate Data. Please Check" 
Else 
    MsgBox " Data Validation Completed . No Duplicate Found. " 
End If 
End Sub