复杂的工资表合并问题求助

cshiq

请老师们帮忙处理。

源文件特征及查询的合并要求：
1、每张表都以统一的表名“正式人员”表存在于一个工作簿，工作簿可能含有多张表。查询只合并该“正式人员”表，并增加一列标题为工作簿名称，如“202401”。
2、源表的表名占用2行，查询所合并后的文件无需保留表名行。
3、源表含有双行标题。要求查询保留单行标题名，双行标题名合并为单行标题名，合并的标题名以冒号分隔。
4、每张表的列标题数目不等，且后续向文件夹中添加的表格可能会有新的标题名列。要求查询结果列出所有标题名，将相同标题名的数据合并在一起。

deadzlq

PQ参考解法

minchar

let
    源 = Folder.Files("C:\Users\minch\Desktop\temp\表格合并\需合并处理的工作簿"),
    删除的其他列 = Table.SelectColumns(源,{"Name", "Content"}),
    重命名的列 = Table.RenameColumns(删除的其他列,{{"Name", "日期"}}),
    取日期 = Table.TransformColumns(重命名的列,{{"日期", each Text.BeforeDelimiter(_,".")}}),
    bin转表 = Table.TransformColumns(取日期,{"Content",each Table.Skip(Excel.Workbook(_){[Name = "正式人员"]}[Data],2)}),
    处理表 = Table.TransformColumns(bin转表,{"Content",each Table.PromoteHeaders( Table.Skip(Table.Transpose(Table.ReplaceValue(Table.FillDown(Table.Transpose(_) ,{"Column1"}),each [Column1],null,(x,y,z) => if x=null then y else y&":"&x ,{"Column2"}))))}),
    展开的Content = Table.ExpandTableColumn(处理表, "Content", Table.ColumnNames(处理表[Content]{2})&{"年度奖金"}, Table.ColumnNames(处理表[Content]{2})&{"年度奖金"}),
    筛选的行 = Table.SelectRows(展开的Content, each [序号] <> null and [序号] <> "")
in
    筛选的行

把目录路径换成你的excel所在位置

limonet

关键字：自定义
let
    源 = Folder.Files(Excel.CurrentWorkbook(){[Name="表1"]}[Content]{0}[路径]),
    删除的其他列 = Table.SelectColumns(源,{"Content", "Name"}),
    转换 = Table.TransformColumns( 删除的其他列,{"Content",each fx(_)},each Text.Replace(Text.From(_),".xlsx","")),
    重排序的列 = Table.ReorderColumns(转换,{"Name", "Content"}),
    深化与展开 = Table.ExpandTableColumn(重排序的列, "Content", List.Distinct(List.Combine(List.Transform(重排序的列[Content],each Table.ColumnNames(_)))))
in
    深化与展开

limonet

关键字：folder.files

3190496160

Sub 数据合并()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
lj = ThisWorkbook.Path & "\需合并处理的工作簿\"
ReDim br(1 To 100000, 1 To 200)
f = Dir(lj & "*.xls*")
y = 2: n = 1
br(1, 1) = "月份"
br(1, 2) = "序号"
Do While f <> ""
    If f <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(lj & f, 0)
        With wb.Worksheets("正式人员")
            r = .Cells(Rows.Count, 2).End(xlUp).Row
            yy = .Cells.Find("*", searchdirection:=xlPrevious).Column
            ar = .Range("a1").Resize(r, yy)
        End With
        mc = Split(wb.Name, ".")(0)
        wb.Close False
        For j = 2 To yy
            If ar(3, j) = "" Then ar(3, j) = ar(3, j - 1)
            If ar(3, j) <> "" Then
                If ar(4, j) <> "" Then
                    bt = ar(3, j) & ":" & ar(4, j)
                Else
                    bt = ar(3, j)
                End If
                lh = d(bt)
                If lh = "" Then
                    y = y + 1
                    d(bt) = y
                    lh = y
                    br(1, y) = bt
                End If
            End If
        Next j
        For i = 5 To UBound(ar)
            If ar(i, 2) <> "" Then
                n = n + 1
                br(n, 1) = mc
                br(n, 2) = n - 1
                For j = 2 To yy
                    If ar(3, j) <> "" Then
                        If ar(4, j) <> "" Then
                            bt = ar(3, j) & ":" & ar(4, j)
                        Else
                            bt = ar(3, j)
                        End If
                        lh = d(bt)
                        br(n, lh) = ar(i, j)
                    End If
                Next j
            End If
        Next i
    End If
f = Dir
Loop
If n = 1 Or y = 1 Then MsgBox "没有需要合并的数据！": End
With Sheets("正式人员")
    .[a1].CurrentRegion.Borders.LineStyle = 0
    .[a1].CurrentRegion = Empty
    .[a1].Resize(n, y) = br
    .[a1].Resize(n, y).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

表格合并.rar (246.81 KB, 下载次数: 1)

2025-2-7 12:33 上传

点击文件名下载附件

cshiq

谢谢楼上回复解答的deadzlq老师、minchar老师、limonet老师、3190496160老师，辛苦你们了。

cshiq

limonet老师的代码太完美了，经测试，实际处理问题时可能出现的各种不确定性都能达到我想要的结果，太强大了！谢谢limonet老师，谢谢ExcelHome！

cshiq

limonet老师的代码太完美了。经测试，能处理实际工作中标题可能出现的各个不确定性，完全实现我希望达到的结果，太强大了。谢谢limonet老师，谢谢ExcelHome！