高亮重複值，從孔片範圍（UsedRange）

Question

我試過下面的宏代碼，但它不是強調從第二個實例重複PLZ幫我出

還有一件事IAM努力做與動態不採取固定範圍（特定範圍）

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 

被你的 「主」 子如下利用：

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