Excel VBA查找替换宏如何在MsgBox中显示匹配值所在列

完全可以实现该需求，只需在原有查找逻辑中新增列信息收集步骤，再将列信息拼入确认弹窗的文本即可，核心查找替换逻辑无需改动。

修改要点 #

• 新增字典对象存储匹配值所在的列名，利用字典的key唯一性自动对列名去重，避免重复展示同一列
• 在查找匹配的循环中，每找到一个符合条件的单元格，就将其对应的列名存入字典
• 修改原有MsgBox的文本拼接逻辑，把收集到的列名列表加入提示内容中

完整修改后代码 #

Option Explicit

Sub cell_all()
    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
    ' 新增：字典对象用来存去重后的列名
    Dim colDict As Object
    Dim colName As String
    Dim colList As String
    
    Set colDict = CreateObject("Scripting.Dictionary")
       
    xFind = Application.InputBox("code / word to search:", "search")
    If xFind = False Then Exit Sub

    RepWith = Application.InputBox("Replace with :", "replace")
    If RepWith = False Then Exit Sub

    Set FoundCell = Cells.Find(What:=xFind, _
            After:=ActiveCell, _
            LookIn:=xlFormulas, _
            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
            ' 新增：收集当前匹配单元格的列名
            colName = Split(FoundCell.Address, "$")(1)
            If Not colDict.exists(colName) Then
                colDict.Add colName, colName
            End If
            
            Set FoundCell = Cells.FindNext(After:=FoundCell)
            If (FoundCell Is Nothing) Then Exit Do
            If (FoundCell.Address = FirstFound.Address) Then Exit Do
        Loop
    End If

    If ResultRange Is Nothing Then
        anser = MsgBox("no occurrence found! ", vbCritical + vbDefaultButton2, "notice!")
        Exit Sub
    End If
    
    ' 新增：拼接列名列表
    colList = Join(colDict.keys, "、")
    ' 如果列太多就截断避免弹窗过大
    If colDict.Count > 10 Then
        colList = Left(colList, InStrRev(colList, "、") - 1) & " 等共" & colDict.Count & "列"
    End If

    ' 修改后的弹窗，加入列信息
    anser = MsgBox("found " & ResultRange.Count & "" & Chr(13) & _
             "<" & xFind & ">" & Chr(13) & _
             "code / word" & Chr(13) & _
             "replace with" & Chr(13) & _
             "<" & RepWith & ">?" & Chr(13) & Chr(13) & _
             "匹配值所在列：" & colList, 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

效果说明 #

修改后弹出的确认框会在原有提示内容的基础上，新增一行展示所有出现过匹配值的列名，列名会自动去重，避免重复显示。如果匹配的列超过10个会自动截断并提示总列数，避免弹窗尺寸溢出。

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