VBA代码修改：无需硬编码工作表名即可对当前激活工作表执行替换

核心问题原因 #

你之前删除写死的工作表激活语句后代码运行在abbrev表的原因是：LoadAbbrevs 过程内部执行了 Sheets("abbrevs").Activate 操作，加载缩写配置后活动工作表就被切换到了abbrevs表，没有切回你原本选中的目标表。

优化后完整代码 #

完全不需要写死工作表名称，运行时自动作用于你当前打开选中的工作表，同时去掉了所有没必要的Activate、Select操作，运行更稳定：

Public gcolWords As New Collection

Public Sub ReplaceAllWrds()
    Dim vWord, vAbv, itm
    Dim i As Integer
    Dim Lastrow As Integer
    Dim targetSheet As Worksheet
    Dim targetRng As Range
    
    ' 先保存当前用户选中的目标工作表，避免后续加载缩写时被切换
    Set targetSheet = ActiveSheet
    
    LoadAbbrevs
    
    ' 直接用保存的目标工作表对象操作，不需要激活
    With targetSheet
        Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set targetRng = .Range("F1:F" & Lastrow)
    End With
    
    For Each itm In gcolWords
        i = InStr(itm, ":")
        vWord = Left(itm, i - 1)
        vAbv = Mid(itm, i + 1)
        ' 直接传入目标区域执行替换，不需要选中
        Replace1Wrd targetRng, vWord, vAbv
    Next
    Set gcolWords = Nothing
    Set targetSheet = Nothing
    Set targetRng = Nothing
End Sub

Private Sub Replace1Wrd(ByVal targetRng As Range, ByVal pvWrd, ByVal pvAbv)
    On Error Resume Next
    targetRng.Replace What:=pvWrd, Replacement:=pvAbv, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

Private Sub LoadAbbrevs()
    Dim vWord, vAbv, vItm
    Dim abvSheet As Worksheet
    Dim startRow As Integer
    
    ' 直接引用abbrevs表不需要激活，不会切换当前活动表
    Set abvSheet = Sheets("abbrevs")
    startRow = 2
    Do While abvSheet.Cells(startRow, 1).Value <> ""
        vWord = abvSheet.Cells(startRow, 1).Value
        vAbv = abvSheet.Cells(startRow, 2).Value
        vItm = vWord & ":" & vAbv
        gcolWords.Add vItm
        startRow = startRow + 1
    Loop
    Set abvSheet = Nothing
End Sub

使用说明 #

只需要你提前点击切换到你要处理的目标工作表，直接运行宏就会自动作用在该表，不需要修改任何代码里的工作表名称。

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