提列数据和表名

ddz79101

老师!希望提取各表中指定的1列数据及其所在表名到《当月缴费人员》，请老师帮忙！谢谢

smiletwo

没明白要做什么

ddz79101

smiletwo 发表于 2024-2-21 12:02
没明白要做什么

老师！最后结果见《当月缴费人员》中图片。就是提各表中按姓名的应缴费额(元)列，放置到《当月缴费人员》

taller

taller

taller

更新代码

1. 
   
2. Option Explicit
   
3. Sub Demo()
   
4.     Dim objDic As Object, rngData As Range
   
5.     Dim i As Long, sKey, c As Range
   
6.     Dim arrData, oSht As Worksheet, sSht
   
7.     Dim iCol As Long, RowCnt As Long
   
8.     Const SUMKEY = "ºÏ¼Æ"
   
9.     Const S_COL = 6
   
10.     Set oSht = Sheets("µ±Ô½ɷÑÈËÔ±")
    
11.     oSht.Columns("F:P").ClearContents
    
12.     oSht.Columns("F:P").NumberFormatLocal = "#,##0.00"
    
13.     For iCol = 5 To 15
    
14.         With oSht.Cells(2, iCol)
    
15.         .Resize(2).Merge
    
16.         .WrapText = True
    
17.         .HorizontalAlignment = xlCenter
    
18.         End With
    
19.     Next
    
20.     Set objDic = CreateObject("scripting.dictionary")
    
21.     For Each c In oSht.Range("D4", oSht.Range("D4").End(xlDown))
    
22.         objDic(Trim(c.Value)) = 0
    
23.     Next
    
24.     objDic(SUMKEY) = 0
    
25.     RowCnt = objDic.Count
    
26.     iCol = S_COL - 1
    
27.     For Each sSht In Split("ÑøÀÏÏÕ£¨ÆóÒµ£© Ò½ÁÆÏÕ£¨ÆóÒµ£© µØ·½Ò½ÁÆÏÕ£¨ÆóÒµ£© " & _
    
28.     "ʧҵÏÕ£¨ÆóÒµ£© ¹¤ÉËÏÕ£¨ÆóÒµ£© ÑøÀÏÏÕ£¨¸öÈË£© Ò½ÁÆÏÕ£¨¸öÈË£© ʧҵÏÕ£¨¸öÈË£©")
    
29.         Set rngData = Sheets(sSht).Range("A1").CurrentRegion
    
30.         arrData = rngData.Value
    
31.         For i = LBound(arrData) + 2 To UBound(arrData)
    
32.             sKey = arrData(i, 1)
    
33.             If objDic.exists(sKey) And sKey <> SUMKEY Then
    
34.                 objDic(sKey) = arrData(i, 7) * 1
    
35.                 objDic(SUMKEY) = objDic(SUMKEY) + arrData(i, 7) * 1
    
36.             End If
    
37.         Next i
    
38.         iCol = iCol + 1
    
39.         oSht.Cells(2, iCol).Value = sSht
    
40.         oSht.Cells(4, iCol).Resize(RowCnt, 1) = Application.Transpose(objDic.items)
    
41.         For Each sKey In objDic.keys
    
42.             objDic(sKey) = 0
    
43.         Next
    
44.     Next
    
45.     Columns("K").Insert
    
46.     Range("K2").Value = "&#198;ó&#210;&#181;&#208;&#161;&#188;&#198;"
    
47.     Range("K4").Resize(RowCnt).FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
    
48.     Range("O2").Value = "&#184;&#246;&#200;&#203;&#208;&#161;&#188;&#198;"
    
49.     Range("O4").Resize(RowCnt).FormulaR1C1 = "=SUM(RC[-3]:R[5]C[-1])"
    
50.     Range("P2").Value = "&#186;&#207;&#188;&#198;"
    
51.     Range("P4").Resize(RowCnt).FormulaR1C1 = "=RC[-5]+RC[-1]"
    
52. End Sub
    

复制代码

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.2.21
   
2.     Dim arr, brr, d
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set ws = ThisWorkbook
   
5.     Set sh = ws.Sheets("当月缴费人员")
   
6.     b = [{"企业","个人"}]
   
7.     For x = 1 To UBound(b)
   
8.         For Each sht In ws.Sheets
   
9.             If InStr(sht.Name, b(x)) Then
   
10.                 With sht
    
11.                     r = .UsedRange.Find("合计").Row - 1
    
12.                     arr = .Range("a1:g" & r)
    
13.                     fn = .Name
    
14.                 End With
    
15.                 For i = 3 To UBound(arr)
    
16.                     s = arr(i, 1)
    
17.                     If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
    
18.                     d(s)(fn) = arr(i, 7)
    
19.                 Next
    
20.             End If
    
21.         Next
    
22.     Next
    
23.     ReDim brr(1 To 1000, 1 To 100)
    
24.     For Each k In d.keys
    
25.         n = n + 1
    
26.         brr(n, 1) = n
    
27.         brr(n, 4) = k
    
28.     Next
    
29.     With sh
    
30.         .UsedRange.Offset(2).Clear
    
31.         .[a3].Resize(n, 4) = brr
    
32.         r = .Cells(Rows.Count, 1).End(3).Row
    
33.         .UsedRange.Offset(r).Clear
    
34.         arr = .Range("a1:o" & r)
    
35.         For i = 3 To UBound(arr)
    
36.             For j = 6 To UBound(arr, 2)
    
37.                 s = arr(i, 4)
    
38.                 If d.exists(s) Then
    
39.                     arr(i, j) = d(s)(arr(2, j))
    
40.                 End If
    
41.             Next
    
42.         Next
    
43.         With .Range("a1:o" & r)
    
44.             .Value = arr
    
45.             .Borders.LineStyle = 1
    
46.             .HorizontalAlignment = xlCenter
    
47.             .VerticalAlignment = xlCenter
    
48.         End With
    
49.         For i = 3 To r
    
50.             .Cells(i, "k") = Application.WorksheetFunction.Sum(.Cells(i, "f").Resize(1, 5))
    
51.             .Cells(i, "n") = Application.WorksheetFunction.Sum(.Cells(i, "l").Resize(1, 2))
    
52.             .Cells(i, "o") = .Cells(i, "k") + .Cells(i, "n")
    
53.         Next
    
54.     End With
    
55.     Set d = Nothing
    
56.     MsgBox "OK！"
    
57. End Sub
    
58. 
    

复制代码

cnmlgb9998

是要这个效果吗？PQ 可以完美。

cnmlgb9998

1. let
   
2.     源 = Excel.Workbook(File.Contents("C:\Users\飞飞\Desktop\VBA\提列及表名.xls"), null, true),
   
3.     筛选的行 = Table.SelectRows(源, each ([Name] <> "当月缴费人员" and [Name] <> "当月钲费变更" and [Name] <> "说明")),
   
4.     已添加自定义 = Table.AddColumn(
   
5.         筛选的行,
   
6.         "自定义",
   
7.         each Table.SelectColumns(
   
8.             Table.SelectRows(
   
9.                 Table.PromoteHeaders(Table.Skip([Data])),
   
10.                 each not Text.Contains([姓名], "合")
    
11.             ),
    
12.             {"姓名", "应缴费额"}
    
13.         )
    
14.     ),
    
15.     删除的列 = Table.RemoveColumns(已添加自定义, {"Data"}),
    
16.     #"展开的“自定义”" = Table.Buffer(Table.ExpandTableColumn(删除的列, "自定义", {"姓名", "应缴费额"}, {"姓名", "应缴费额"})),
    
17.     更改的类型 = Table.TransformColumnTypes(#"展开的“自定义”", {{"应缴费额", type number}}),
    
18.     分组的行 = Table.Group(更改的类型, {"姓名"}, {{"all", each _}}),
    
19.     已添加自定义1 = Table.AddColumn(
    
20.         分组的行,
    
21.         "自定义",
    
22.         each Table.AddColumn([all], "分组", each if Text.Contains(_[Name], "个") then 1 else 2)
    
23.     ),
    
24.     已添加自定义2 = Table.AddColumn(已添加自定义1, "自定义.1", each Table.Group([自定义], "分组", {"data", each _})),
    
25.     删除的列1 = Table.RemoveColumns(已添加自定义2, {"all", "自定义"}),
    
26.     #"展开的“自定义.1”" = Table.ExpandTableColumn(删除的列1, "自定义.1", {"data"}, {"data"}),
    
27.     已添加自定义3 = Table.AddColumn(#"展开的“自定义.1”", "自定义", each List.Sum([data][应缴费额])),
    
28.     已添加自定义4 = Table.AddColumn(
    
29.         已添加自定义3,
    
30.         "自定义.1",
    
31.         each Table.FromRows(
    
32.             List.Combine(
    
33.                 {
    
34.                     Table.ToRows([data]),
    
35.                     {
    
36.                         {
    
37.                             if Text.Contains([data][Name]{0}, "个") then "个人缴费" else "公司缴费",
    
38.                             "",
    
39.                             [自定义],
    
40.                             ""
    
41.                         }
    
42.                     }
    
43.                 }
    
44.             )
    
45.         )
    
46.     ),
    
47.     删除的其他列 = Table.SelectColumns(已添加自定义4, {"姓名", "自定义.1"}),
    
48.     #"展开的“自定义.1”1" = Table.ExpandTableColumn(
    
49.         删除的其他列,
    
50.         "自定义.1",
    
51.         {"Column1", "Column3"},
    
52.         {"Column1", "Column3"}
    
53.     ),
    
54.     已透视列 = Table.Pivot(
    
55.         #"展开的“自定义.1”1",
    
56.         List.Distinct(#"展开的“自定义.1”1"[Column1]),
    
57.         "Column1",
    
58.         "Column3",
    
59.         List.Sum
    
60.     ),
    
61.     已添加自定义5 = Table.AddColumn(已透视列, "总计", each [个人缴费] + [公司缴费]),
    
62.     自定义1 = {"总计"}
    
63.         & List.Transform(List.Skip(Table.ToColumns(已添加自定义5)), each List.Sum(List.RemoveNulls(_))),
    
64.     自定义2 = Table.FromRows(Table.ToRows(已添加自定义5) & {自定义1}, Table.ColumnNames(已添加自定义5))
    
65. in
    
66.     自定义2

复制代码