基于工作表名称从多工作表提取指定数据的Excel需求

公式方案（适用于Excel 365/2021动态数组版本） #

直接使用以下嵌套公式，可自动筛选BEGINNING和DIVIDER之间名称含"Jobs"的工作表，提取其中B列非空的A13:M513区域数据：

=LET(
    AllSheetNames, TEXTBEFORE(GET.WORKBOOK(1), "!"),
    StartPos, MATCH("BEGINNING", AllSheetNames, 0),
    EndPos, MATCH("DIVIDER", AllSheetNames, 0),
    JobsSheets, FILTER(AllSheetNames, ISNUMBER(SEARCH("Jobs", AllSheetNames)) * (ROW(AllSheetNames) > StartPos) * (ROW(AllSheetNames) < EndPos)),
    CombinedData, VSTACK(INDIRECT("'" & JobsSheets & "'!A13:M513")),
    ColumnBData, VSTACK(INDIRECT("'" & JobsSheets & "'!B13:B513")),
    FILTER(CombinedData, ColumnBData <> "", "NO CURRENT OPPORTUNITIES")
)

注意事项 #

• 公式依赖GET.WORKBOOK(1)宏函数，需启用工作簿宏：文件>选项>信任中心>信任中心设置>宏设置>启用所有宏
• 新增/删除Jobs工作表后，按Ctrl+Alt+F9强制重算即可更新结果

VBA宏方案（无需依赖动态数组或宏函数） #

如果不想启用宏公式，可使用VBA代码实现自动提取：

Sub ExtractJobsData()
    Dim wsDest As Worksheet
    Dim ws As Worksheet
    Dim startIdx As Integer, endIdx As Integer
    Dim lastRow As Long, destRow As Long
    
    ' 定位或创建目标工作表
    On Error Resume Next
    Set wsDest = ThisWorkbook.Worksheets("Opportunities")
    On Error GoTo 0
    If wsDest Is Nothing Then
        Set wsDest = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        wsDest.Name = "Opportunities"
    End If
    
    ' 清空目标表原有数据（保留A1:A12区域，若有表头可按需调整）
    wsDest.Range("A13:M" & wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Row).ClearContents
    
    ' 确定工作表范围边界
    startIdx = ThisWorkbook.Worksheets("BEGINNING").Index + 1
    endIdx = ThisWorkbook.Worksheets("DIVIDER").Index - 1
    destRow = 13 ' 目标表从A13开始写入数据
    
    ' 遍历筛选目标工作表
    For i = startIdx To endIdx
        Set ws = ThisWorkbook.Worksheets(i)
        If InStr(1, ws.Name, "Jobs", vbTextCompare) > 0 Then
            lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
            If lastRow >= 13 Then
                lastRow = Application.Min(lastRow, 513)
                ' 复制B列非空的数据到目标表
                ws.Range("A13:M" & lastRow).SpecialCells(xlCellTypeConstants).Copy Destination:=wsDest.Range("A" & destRow)
                destRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Row + 1
            End If
        End If
    Next i
    
    ' 无数据时显示提示
    If destRow = 13 Then wsDest.Range("A13").Value = "NO CURRENT OPPORTUNITIES"
    
    MsgBox "数据提取完成！", vbInformation
End Sub

使用方法 #

1. 按Alt+F11打开VBA编辑器
2. 插入新模块，粘贴上述代码
3. 运行宏即可完成提取，新增/删除Jobs工作表后重新运行宏即可更新结果

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