修改Power Query公式：将文件夹中Excel文件生成独立工作表表格

我用Excel Power Query高级编辑器里的公式导入数据，但这个公式会把文件夹里所有Excel文件合并成单个表格。我想给文件夹里的每个Excel文件生成单独的表格，放在不同工作表里，请问可行吗？如果可行，能不能帮我完善代码？

我尝试用当前公式时，Power Query没法把数据导入Excel。预期效果是把两个示例文件导入成两个不同工作表里的独立表格。

现有公式：

let Source = Folder.Files("C:\subdirectory\directory"),
#"Filtered Rows" = Table.SelectRows(Source, each ([Extension] = ".xlsx")),
#"Removed Other Columns" = Table.SelectColumns(#"Filtered Rows",{"Name", "Content"}),
#"Added Custom" = Table.AddColumn(#"Removed Other Columns", "GetFileData", each Excel.Workbook([Content],true)),
#"Expanded GetFileData" = Table.ExpandTableColumn(#"Added Custom", "GetFileData", {"Data", "Hidden", "Item", "Kind", "Name"}, {"Data", "Hidden", "Item", "Kind", "Sheet"}),
#"Removed Columns" = Table.RemoveColumns(#"Expanded GetFileData",{"Content", "Hidden", "Item", "Kind"}),
List = List.Union(List.Transform(#"Removed Columns"[Data], each Table.ColumnNames(_))),
#"Expanded Data" = Table.ExpandTableColumn(#"Removed Columns", "Data", List,List)
in  #"Expanded Data"

可行，以下是两种实现方法：

方案一：Power Query生成带标识的合并表 + VBA拆分到工作表 #

1. 修改Power Query代码保留文件名标识 #

先调整现有代码，给每条数据加上原文件名，方便后续按文件拆分：

let
    Source = Folder.Files("C:\subdirectory\directory"),
    #"筛选行" = Table.SelectRows(Source, each ([Extension] = ".xlsx")),
    #"移除其他列" = Table.SelectColumns(#"筛选行",{"Name", "Content"}),
    #"添加自定义列" = Table.AddColumn(#"移除其他列", "获取文件数据", each Excel.Workbook([Content], true)),
    #"展开获取文件数据" = Table.ExpandTableColumn(#"添加自定义列", "获取文件数据", {"Data", "Name"}, {"数据", "工作表名"}),
    #"移除列" = Table.RemoveColumns(#"展开获取文件数据",{"Content"}),
    // 统一所有文件的列名
    列名列表 = List.Union(List.Transform(#"移除列"[数据], each Table.ColumnNames(_))),
    #"展开数据" = Table.ExpandTableColumn(#"移除列", "数据", 列名列表, 列名列表)
in
    #"展开数据"

将这个查询加载到Excel的一个工作表（命名为「合并数据」）。

2. 用VBA拆分到独立工作表 #

按Alt+F11打开VBA编辑器，插入模块后粘贴以下代码：

Sub SplitToSheets()
    Dim ws As Worksheet, newWs As Worksheet
    Dim lastRow As Long, i As Long
    Dim fileName As String
    Dim dict As Object
    
    Set dict = CreateObject("Scripting.Dictionary")
    Set ws = ThisWorkbook.Worksheets("合并数据")
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
    ' 遍历数据，按文件名分组拆分
    For i = 2 To lastRow
        fileName = ws.Cells(i, "Name").Value
        ' 去掉文件扩展名
        fileName = Left(fileName, InStrRev(fileName, ".") - 1)
        
        If Not dict.Exists(fileName) Then
            dict.Add fileName, True
            ' 创建新工作表
            Set newWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            newWs.Name = fileName
            ' 复制表头
            ws.Rows(1).Copy newWs.Rows(1)
        End If
        ' 复制当前行到对应工作表
        ws.Rows(i).Copy newWs.Cells(newWs.Rows.Count, 1).End(xlUp).Offset(1, 0)
    Next i
    
    MsgBox "拆分完成！"
End Sub

运行宏即可自动按文件名创建工作表并拆分数据。

方案二：Power Query生成单个文件查询（手动加载） #

如果不想用VBA，可为每个文件单独创建查询：

1. 先获取文件夹内的文件列表，确认所有目标文件路径和名称；
2. 针对单个文件创建查询，以「城市1数据文件」为例：

let
    Source = Excel.Workbook(File.Contents("C:\subdirectory\directory\城市1数据文件.xlsx"), true),
    目标工作表 = Source{[Item="工作表1",Kind="Sheet"]}[Data],
    #"提升标题" = Table.PromoteHeaders(目标工作表, [PromoteAllScalars=true])
in
    #"提升标题"

重复此步骤为每个文件创建查询，再分别加载到独立工作表即可。

注意事项 #

• 替换代码中的C:\subdirectory\directory为你的实际文件夹路径；
• 若文件内有多个工作表，方案一中的代码会合并所有工作表数据，如需仅保留第一个工作表，可在Excel.Workbook后添加筛选条件；
• VBA代码运行前需确保启用宏，且「合并数据」工作表的表头包含Name列（原文件名）。

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