Excel VBA查找替换宏对复制粘贴输入的值不生效问题咨询

问题根源 #

你遇到的问题核心是两个原因导致：

• 复制粘贴的内容通常会附带不可见空白字符：比如首尾空格、非断空格（ASCII 160，从网页/其他软件复制时高频出现）、制表符、换行符，手动输入内容不会附带这类字符，所以能正常匹配
• 查找逻辑参数配置不一致：原代码Find方法用LookIn:=xlFormulas匹配公式内容，但后续替换是直接修改单元格值，若匹配对象是单元格的显示值而非公式本身，就会出现匹配失败的情况

修复方案 #

你只需要修改两处代码即可：

1. 对输入的搜索内容做清洗，剔除所有不可见空白字符
2. 调整Find方法的LookIn参数为xlValues，匹配单元格显示值，和后续替换逻辑对齐

修改后完整代码 #

Option Explicit

Sub cell_all_new_2() 'celle colonna

Dim FoundCell As Range
Dim FirstFound As Range
Dim xFind As Variant
Dim ResultRange As Range
Dim RepWith As Variant
Dim anser As Integer
Dim CellsToRep As Variant
Dim j As Long
Dim mAdrs As String

Dim Col As Variant
Dim avviso As String
       
xFind = Application.InputBox("code / word to search:", "search")
If xFind = False Then Exit Sub
' 新增：清洗搜索内容，剔除不可见空白字符
xFind = Trim(xFind) ' 剔除首尾普通空格
xFind = Replace(xFind, Chr(160), "") ' 剔除非断空格
xFind = Replace(xFind, vbTab, "") ' 剔除制表符
xFind = Replace(xFind, vbCr, "") ' 剔除回车符
xFind = Replace(xFind, vbLf, "") ' 剔除换行符

RepWith = Application.InputBox("Replace with :", "replace")
If RepWith = False Then Exit Sub
' 可选：替换内容也做相同清洗，避免替换结果带多余字符
RepWith = Trim(RepWith)
RepWith = Replace(RepWith, Chr(160), "")
RepWith = Replace(RepWith, vbTab, "")
RepWith = Replace(RepWith, vbCr, "")
RepWith = Replace(RepWith, vbLf, "")

' 修改：LookIn参数从xlFormulas改为xlValues
Set FoundCell = Cells.Find(What:=xFind, _
        After:=ActiveCell, _
        LookIn:=xlValues, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        MatchCase:=False)
           
If Not FoundCell Is Nothing Then

    Set FirstFound = FoundCell
    Do Until False
        If ResultRange Is Nothing Then
            Set ResultRange = FoundCell
        Else
            Set ResultRange = Application.Union(ResultRange, FoundCell)
        End If
        
        Set FoundCell = Cells.FindNext(After:=FoundCell)
         
        If (FoundCell Is Nothing) Then
            Exit Do
        End If
        If (FoundCell.Address = FirstFound.Address) Then
            Exit Do
        End If
    Loop
End If

If ResultRange Is Nothing Then
    anser = MsgBox("no occurrence found! ", vbCritical + vbDefaultButton2, "notice!")
    Exit Sub
End If

Dim loopCell As Range
Dim colDict As Object
Set colDict = CreateObject("Scripting.Dictionary")

'Loop through each cell and assign the column letter from its address to the dictionary (to remove duplicate)
For Each loopCell In ResultRange.Cells
    colDict(Split(loopCell.Address, "$")(1)) = 1
Next loopCell

'Assign an array from the dictionary keys
Dim colArr As Variant
colArr = colDict.Keys
Set colDict = Nothing

'Sort the array alphabetically
Quicksort colArr, LBound(colArr), UBound(colArr)

anser = MsgBox("found " & ResultRange.Count & "" & vbCr & _
         "<" & xFind & ">" & vbCr & _
         "in column <" & Join(colArr, " / ") & ">" & vbCr & _
         "code / word" & vbCr & _
         "replace with" & vbCr & _
         "<" & RepWith & ">?", vbInformation + vbYesNo, "NOTICE!")

If anser = vbNo Then Exit Sub

mAdrs = ResultRange.Address
mAdrs = Replace(mAdrs, ":", ",")
CellsToRep = Split(mAdrs, ",")

For j = 0 To UBound(CellsToRep)
    Range(CellsToRep(j)) = Replace(Range(CellsToRep(j)), xFind, RepWith)
Next

End Sub

Sub Quicksort(vArray As Variant, arrLbound As Long, arrUbound As Long)
    'Sorts a one-dimensional VBA array from smallest to largest
    'using a very fast quicksort algorithm variant.
    Dim pivotVal As Variant
    Dim vSwap    As Variant
    Dim tmpLow   As Long
    Dim tmpHi    As Long
     
    tmpLow = arrLbound
    tmpHi = arrUbound
    pivotVal = vArray((arrLbound + arrUbound) \ 2)
     
    While (tmpLow <= tmpHi) 'divide
       While (vArray(tmpLow) < pivotVal And tmpLow < arrUbound)
          tmpLow = tmpLow + 1
       Wend
      
       While (pivotVal < vArray(tmpHi) And tmpHi > arrLbound)
          tmpHi = tmpHi - 1
       Wend
     
       If (tmpLow <= tmpHi) Then
          vSwap = vArray(tmpLow)
          vArray(tmpLow) = vArray(tmpHi)
          vArray(tmpHi) = vSwap
          tmpLow = tmpLow + 1
          tmpHi = tmpHi - 1
       End If
    Wend
     
    If (arrLbound < tmpHi) Then Quicksort vArray, arrLbound, tmpHi 'conquer
    If (tmpLow < arrUbound) Then Quicksort vArray, tmpLow, arrUbound 'conquer
End Sub

补充说明 #

如果你需要完全匹配单元格内容而非部分匹配，可以把Find方法的LookAt:=xlPart修改为LookAt:=xlWhole。

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