使用红色，从孔表范围（UsedRange）突出显示第二个实例的重复值

我试着用下面的macros代码，但它没有突出重复从第二实例Plz帮助我

还有一件事iam试图做dynamic不采取固定范围（特定范围）

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

你可以把你的sub变成一个函数：

 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