如何将VBA代码关联到命令按钮并实现从关闭工作簿获取数据

最终修改代码 #

Public Sub ExtractMatchData()
    Dim Chck As Integer, Cnt As Integer
    Dim Save As String
    Dim Subjt As Integer
    Dim srcWb As Workbook
    Dim searchVal As Variant
    
    ' 读取当前表A1作为查询条件，对应原事件的A1变更触发逻辑
    searchVal = ThisWorkbook.Worksheets("Sheet1").Range("A1").Value
    If searchVal = "" Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    On Error GoTo ErrHandle
    ' 后台静默打开关闭的源数据文件，可替换为你实际的Data2.xlsm绝对路径
    Set srcWb = Workbooks.Open(FileName:=ThisWorkbook.Path & "\Data2.xlsm", Visible:=False)
    
    With srcWb.Worksheets("Datas")
        ThisWorkbook.Worksheets("Sheet1").Cells.Clear
        For Chck = 2 To .Cells(.Rows.Count, "C").End(xlUp).Row
            Select Case .Cells(Chck, "C").Value
                Case "Number"
                    Subjt = Chck
                Case ""
                    If Save <> "" Then
                        Save = "C" & Subjt & ":Q" & Subjt & Save
                        .Range(Save).Copy
                        Cnt = ThisWorkbook.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
                        If Cnt > 1 Then Cnt = Cnt + 2
                        ThisWorkbook.Worksheets("Sheet1").Range("A" & Cnt).PasteSpecial Paste:=xlPasteAll
                        Save = ""
                    End If
                Case searchVal
                    If .Cells(Chck, "B").Value = "Number" Then Save = Save & ", C" & Chck & ":Q" & Chck
            End Select
        Next
    End With
    
ErrHandle:
    ' 关闭源文件，不保存任何修改
    If Not srcWb Is Nothing Then srcWb.Close SaveChanges:=False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    ' 清空剪贴板缓存
    Application.CutCopyMode = False
End Sub

适配说明 #

• 按钮触发适配：将原工作表变更事件改为普通公共宏，去掉了事件触发的相关判断逻辑，直接读取当前工作簿Sheet1的A1单元格值作为查询条件。绑定按钮方法：点击Excel顶部「开发工具」选项卡→「插入」→选择「表单控件（按钮）」，在工作表上绘制按钮后，选择ExtractMatchData宏完成绑定即可。
• 关闭工作簿读取适配：新增后台静默打开逻辑，运行时不会弹出源文件Data2.xlsm的窗口，读取完成后会自动关闭源文件，不会修改源文件的原有内容。如果Data2.xlsm和当前工作簿不在同一个文件夹，将代码中ThisWorkbook.Path & "\Data2.xlsm"替换为实际的文件绝对路径即可，比如"C:\Users\用户名\Desktop\Data2.xlsm"。

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