Excel VBA：如何让 COUNTIF 函数不将文本单元格“1.1”和“1.10”作为重复项？

Posted 2023-03-29

【中文标题】Excel VBA：如何让 COUNTIF 函数不将文本单元格“1.1”和“1.10”作为重复项？

【英文标题】：Excel VBA: How to get COUNTIF function to not pick up text cells "1.1" and "1.10" as Duplicates?

【发布时间】：2021-04-28 18:02:31

【问题描述】：

我在 Excel VBA 中使用 CountiF 函数来检查 ID 号数组的重复项，如下所示：

1.0 1.1 1.2 1.3 1.4 1.5 1.6 1.7 1.8 1.9 1.10 1.11 ...

使用我使用的代码，格式为文本单元格的“1.1”和“1.10”在我不希望它们出现时显示为重复项。

以下是我的代码，我想知道如果可能的话，什么调整可以解决这个问题？

谢谢。

    'RESET ERROR IN HISTORY
        Workbooks("PERSONAL.xlsb").Sheets("History").Range("F2").Value = "No Duplicates"
    
    'SET STARTING CELL
        Cells(1, 3).Select
    
    'GET ACTIVE COLUMN
        Dim Col As Long
        Col = ActiveCell.Column
        
    'ESTABLISH END ROW
        Call Get_Last_Row
        Dim EndRow As Long
        EndRow = ActiveCell.Row
        Cells(1, Col).Select
        
    'RUN MAIN LOOP
        Dim Cell As Variant
        Dim Source As Range
        Set Source = Range(Cells(1, Col), Cells(EndRow, Col))

        For Each Cell In Source
        
            If Application.WorksheetFunction.CountIf(Source, Cell) > 1 Then
                Workbooks("PERSONAL.xlsb").Sheets("History").Range("F2").Value = "Duplicates"
                Cell.Interior.ThemeColor = xlThemeColorAccent5
            End If
        
        Next
        
        If Workbooks("PERSONAL.xlsb").Sheets("History").Range("F2").Value = "Duplicates" Then
            MsgBox "Duplicate Sheet Names Found"
        End If

【参考方案1】：

您可以使用Worksheet.Evaluate 代替Worksheet.Evaluate 来运行一个数组公式，该公式不会像计算数字一样计算单元格：

Dim dupes As Long, c As Range, ws As Worksheet, col As Long, rng As Range, n

Set ws = ActiveSheet 'or whatever

col = ActiveCell.Column
Set rng = ws.Range(ws.Cells(1, col), ws.Cells(Rows.Count, col).End(xlUp))
    
For Each c In rng.Cells
    'this will not count values as numbers...
    n = ws.Evaluate("=SUM(1*(" & rng.Address & "=" & c.Address & "))")
    If n > 1 Then
        dupes = dupes + 1
        c.Interior.ThemeColor = xlThemeColorAccent5
    Else
        c.Interior.ColorIndex = xlNone
    End If
Next
    
Workbooks("PERSONAL.xlsb").Sheets("History").Range("F2").Value = _
               IIf(dupes > 0, "Duplicates", "No Duplicates")
               
If dupes > 0 Then MsgBox "Duplicate Sheet Names Found"