如何修改Excel VBA宏代码，使其运行后返回初始调用工作簿？

以下是针对你的代码的具体修改点，确保宏结束后返回初始运行时的工作簿：

1. 启用强制变量声明（规范代码，避免隐式错误） #

在模块的最顶部添加强制声明语句，避免因隐式变量类型导致的意外问题：

Option Explicit

2. 关闭屏幕刷新，隐藏中间工作簿切换 #

原代码中Application.ScreenUpdating = True会让用户看到宏运行时的工作簿切换，修改为关闭状态，最后再恢复：

Application.ScreenUpdating = False  ' 替换原代码中的True

3. 显式声明所有未定义变量 #

原代码中myrange、sht、myoutputcolumn未显式声明，添加对应的声明语句：

Dim myrange As Range
Dim sht As Worksheet
Dim myoutputcolumn As String

4. 调整激活原工作簿与恢复设置的顺序 #

确保在恢复Excel常规设置前先激活初始工作簿，避免用户看到不必要的界面跳转：

• 正常流程中将wbActive.Activate移到恢复设置之前
• 错误处理中也要恢复所有Excel设置，避免异常状态残留

修改后的完整代码 #

Option Explicit

Sub FindMatchingDataV2()
'This macro was designed to allow users an easy way to find
'matching data between two ranges, either within the same worksheet or across
'worksheets within the same workbook, or even between two separate workbooks.

Dim wbActive As Workbook
Set wbActive = ActiveWorkbook

On Error GoTo Error_handler

Application.EnableEvents = False
Application.Calculation = xlManual
Application.ScreenUpdating = False  ' 关闭屏幕刷新

Dim MySearchRange As Range
Dim c As Range
Dim findC As Variant
Dim myrange As Range
Dim sht As Worksheet
Dim myoutputcolumn As String
    
Set myrange = Application.InputBox( _
Prompt:="Select the range of cells containing the data you are looking for:", Type:=8)

Dim myRangeArray As Variant
myRangeArray = myrange.Value

Set MySearchRange = Application.InputBox( _
    Prompt:="Select the range you wish to investigate:", Type:=8)

Dim MSRArray As Variant
MSRArray = MySearchRange.Value

Dim Response As String
Response = InputBox(Prompt:="Specify the comment you wish to appear to indicate the data was found:")

myoutputcolumn = Application.InputBox( _
Prompt:="Enter the alphabetical column letter(s) to specify the column you want the message to appear in.")
    
Dim outArray As Variant
ReDim outArray(1 To UBound(myRangeArray, 1), 1 To 1)
    
Set sht = myrange.Parent

Dim i As Long
For i = 1 To UBound(myRangeArray, 1)
    Dim j As Long
    For j = 1 To UBound(MSRArray, 1)
        If myRangeArray(i, 1) = MSRArray(j, 1) Then
            outArray(i, 1) = Response
            Exit For
        End If
    Next j
Next i

sht.Cells(myrange.Row, myoutputcolumn).Resize(UBound(outArray, 1), 1).Value = outArray
            
' 先激活原工作簿，再恢复Excel默认设置
wbActive.Activate
Application.EnableEvents = True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

MsgBox "Investigation completed."

Exit Sub
 
Error_handler:
' 错误发生时先恢复初始工作簿与Excel设置
wbActive.Activate
Application.EnableEvents = True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
MsgBox "This macro will now close."

End Sub

关键修改说明 #

• 关闭屏幕刷新：避免用户感知到宏运行过程中的工作簿切换，同时确保最终界面停留在初始工作簿
• 强制变量声明：减少隐式变量带来的潜在bug，提升代码稳定性
• 错误处理完善：确保无论是否发生错误，都能恢复Excel的正常状态并切回初始工作簿

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