突出重复的值，如何显示在msgbox例如： – 重复单元格值（2）重复3次
我正在寻找一种在msgbox中显示dynamic值的方法。
例如： – 重复单元格值（2）重复3次 。
这是我在我的代码中写的：
'this function for to highlight duplicates Function FindingDuplicate(rng As Range, counter As Long) As Boolean Dim cell As Range 'For each lopp for getting all cell values For Each cell In rng ' Checking the condition wheather cell value is reapted or not 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 'This is my Main() Sub main() Dim counter As Long 'Calling Function 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 你可能想要使用Dictionary对象（在你的VBA IDE中点击Tools-> References，向下滚动“Available references”列表框直到“Microsoft Scripting Runtime”条目并勾选它的复选标记，最后点击“OK”button）
Function FindingDuplicate(rng As Range, nDupes As Long, dupes As Scripting.Dictionary) As Boolean Dim cell As Range Dim dupesCounter As Long For Each cell In rng dupesCounter = WorksheetFunction.CountIf(Range(rng(1, 1), cell), cell.Value) - 1 If dupesCounter > 0 Then cell.Interior.Color = vbRed dupes.Item(cell.Value) = dupesCounter Else cell.Interior.Pattern = xlNone End If Next FindingDuplicate = dupes.count > 0 End Function
所以你的“主”子变成：
Sub main() Dim nDupes As Long Dim dupe As Variant Dim dupes As Scripting.Dictionary '<--| declare a 'Dictionary' object Set dupes = New Scripting.Dictionary '<--| instantiate the 'Dictionary' object 'Calling Function If FindingDuplicate(ActiveSheet.UsedRange, nDupes, dupes) Then '<--| change 'ActiveSheet.UsedRange' to whatever range you want With dupes For Each dupe In .keys MsgBox "duplicate cell value (" & dupe & ") is duplicated " & .Item(dupe) & " times" Next End With Else MsgBox " Data Validation Completed. No Duplicate Found." End If End Sub
如果我正确理解你想要的东西，你想在你的消息框中有一个dynamic的字段，包含你定义的variables的值。 要做到这一点，你可以尝试
MsgBox( Counter & " cells (with red background) contain duplicate data. Please check!")
Counter是dynamic的领域。 如果我们说计数器= 3，你会得到"3 cells (with red background) contain duplicate data. Please check!" 。 如果这样做，你可以定制它来显示你想要显示的特定文本。
你可以尝试使用一个Dictionary 。
首先，循环使用工作表（“SheetName”），而不是ActiveSheet ，并find所有的唯一值（没有空单元格），并将它们存储在Dictionary 。
之后，循环遍历Dictionary.Keys ，并通过每个唯一键search你的范围，看看有多less重复存在（如果你想显示范围内的所有重复值）。
我修改了你的Function一点，所以它会返回重复的次数，然后回到main Sub ，如果counter > 1然后显示“重复” MsgBox和在该范围内发现了多less次。
码
'this function for to highlight duplicates Function NumOfDuplicates(rng As Range, Lookfor As Variant) As Long Dim cell As Range NumOfDuplicates = 0 ' init value ' Checking the condition wheather cell value is reapted or not For Each cell In rng If cell.Value = Lookfor Then If WorksheetFunction.CountIf(rng, Lookfor) > 1 Then cell.Interior.Color = vbRed NumOfDuplicates = WorksheetFunction.CountIf(rng, Lookfor) Else cell.Interior.pattern = xlNone End If End If Next cell End Function '===================================================================== 'This is my Main() Sub main() Dim counter As Long Dim C As Range Dim Dic As Object, Key As Variant Dim Dup As Boolean Dup = False '<-- init flag ' --- create a dictionary to save all unique values in range --- Set Dic = CreateObject("Scripting.Dictionary") With Worksheets("Sheet1") '<-- replace "Sheet1" with your sheet's name (don't use ActiveSheet) For Each C In .UsedRange If C.Value <> "" Then If Not Dic.exists(C.Value) Then Dic.Add C.Value, C.Value '<-- add unique values to dictionary End If End If Next C For Each Key In Dic.Keys ' <-- loop through unique keys 'Calling Function counter = NumOfDuplicates(.UsedRange, Key) If counter > 1 Then Dup = True MsgBox "Duplicate value " & Key & " found " & counter & " times (red background). Please Check" End If Next Key If Dup = False Then MsgBox "Data Validation Completed. No Duplicate Found." End With End Sub