Excel VBA查找替换宏对常规/文本格式单元格匹配计数异常

该VBA宏计数结果错误的核心原因是计数逻辑重复计算了文本格式存储的数值，具体问题和修复方案如下：

原始问题表现 #

• 待查找单元格为常规格式时宏功能正常，单元格为文本格式时查找值会被重复计数，工作簿同时存在两种格式的单元格
• 测试查找数值500时，B列为文本格式，其余列为常规格式，宏返回匹配数18，实际正确匹配数为15

错误原因 #

原始代码的计数部分存在逻辑漏洞：

' 第一次计数：模糊匹配所有包含查找值的单元格，包含文本型数值
result_1 = Application.WorksheetFunction.CountIf(Columns(Col), "*" & VecchioValore & "*")
If IsNumeric(VecchioValore) Then
  ' 第二次计数：额外加一次精确匹配数值，文本型的数值会被再次统计到
  result_1 = result_1 + Application.WorksheetFunction.CountIf(Columns(Col), VecchioValore)
End If

两次计数叠加后，文本格式存储的数值会被统计2次，常规格式的数值仅被统计1次，最终结果就会比实际值多，测试场景里刚好有3个文本型500，15+3=18和错误结果完全吻合。

修复方案 #

将上述计数逻辑替换为遍历判断的写法，统一将单元格值和查找值转换为字符串对比，彻底规避格式差异带来的计数错误：

模糊匹配（查找包含目标值的单元格，和原逻辑匹配规则一致） #

Dim cell As Range
result_1 = 0
For Each cell In IntervalloDiRicerca
    If InStr(1, CStr(cell.Value), CStr(VecchioValore), vbTextCompare) > 0 Then
        result_1 = result_1 + 1
    End If
Next cell

精确匹配（仅查找完全等于目标值的单元格，按需选用） #

Dim cell As Range
result_1 = 0
For Each cell In IntervalloDiRicerca
    If CStr(cell.Value) = CStr(VecchioValore) Then
        result_1 = result_1 + 1
    End If
Next cell

修复后完整代码 #

Sub sostituisci_codice_2()

    Dim VecchioValore   As Variant, _
        NuovaPparola    As Variant, _
        TrovatoSu       As Variant
        
    Dim IntervalloDiRicerca As Range
    Dim Avviso              As Variant
    Dim Col                 As String
    Dim result_1            As Double
    Dim add As String
    Dim cell As Range
    
    Col = Application.InputBox("inserisci la colonna:", "SCEGLI COLONNA")
    
    Select Case Col
         Case Is = ""
            Avviso = MsgBox("Devi inserire una colonna!", vbCritical + vbDefaultButton2, "AVVISO!")
            Exit Sub
        Case Is = UCase(False)
            Exit Sub
   End Select
   
On Error GoTo BadAdd

Set IntervalloDiRicerca = Columns(Col)
VecchioValore = Application.InputBox("codice/parola da ricercare:", "TROVA")

    Select Case VecchioValore
         Case Is = ""
            Avviso = MsgBox("Devi inserire un codice/parola!", vbCritical + vbDefaultButton2, "AVVISO!")
            Exit Sub
        Case Is = False
            Exit Sub
    End Select
    
    Set TrovatoSu = IntervalloDiRicerca.Find(VecchioValore)
    
    If Not TrovatoSu Is Nothing Then
        ' 替换后的计数逻辑，此处用的是模糊匹配，需要精确匹配就换上面的精确匹配代码
        result_1 = 0
        For Each cell In IntervalloDiRicerca
            If InStr(1, CStr(cell.Value), CStr(VecchioValore), vbTextCompare) > 0 Then
                result_1 = result_1 + 1
            End If
        Next cell
        
        Avviso = MsgBox("trovato " & result_1 & " " & Chr(13) & _
        "< " & VecchioValore & " > " & Chr(13) & _
        "codice/parola", vbInformation + vbDefaultButton2, "AVVISO!")
        
        NuovaPparola = Application.InputBox("nuovo codice/parola:", "SOSTITUISCI")
        If NuovaPparola = False Then
            Exit Sub
        Else
            IntervalloDiRicerca.Replace VecchioValore, NuovaPparola, xlPart, xlByRows, False, False, False, False
            Set IntervalloDiRicerca = Nothing
        End If

     Else
        Avviso = MsgBox("nessun codice/parola trovato!", vbCritical + vbDefaultButton2, "AVVISO!")
        Exit Sub
    End If

Exit Sub

BadAdd:
   MsgBox "Valore non valido." & Chr(13) & _
          "Devi inserire una lettera/colonna !", vbCritical + vbDefaultButton2, "AVVISO!"

End Sub

内容的提问来源于stack exchange，提问作者maxma62