Excel VBA：需要此宏将用户返回到运行宏时所在的工作簿

Question

我有一个用于比较范围以查找匹配数据的宏。这些范围可以位于同一工作表、不同工作表甚至不同工作簿中。

此宏可通过用户的 Personal.xlsb 文件在 Excel 功能区中使用。

有时，当宏完成时，用户发现自己位于“其他”工作簿中，而不是运行宏时所在的工作簿。这不是预期的行为，因此用户可能会因此感到有点迷失方向。

我需要在 Visual Basic 代码中进行哪些更改才能确保宏将用户返回到他们第一次运行宏时所在的任何工作簿？

这是代码：

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.

On Error GoTo Error_handler:

    Application.EnableEvents = False
    Application.Calculation = xlManual
    Application.ScreenUpdating = True
    
    
    
    Dim MySearchRange As Range
    Dim c As Range
    Dim findC As Variant
    
    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
            
    sht.Activate
    sht.Range("A1").Select
    

    Application.EnableEvents = True
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "Investigation completed."


Exit Sub
Error_handler:
MsgBox "This macro will now close."

End Sub

Answer 1

存储最初活动的工作簿，然后在最后激活。添加到开头：

Dim wbActive As Workbook
Set wbActive = ActiveWorkbook

最后：

wbActive.Activate