N个工作子表-按月份汇总数据

zllyyz

shiruiqiang 发表于 2024-1-12 11:37
褚老师的代码上修改一下就行

如果想在Sheet1的 随意放置结果列 "表名"、"名字"、d.Items（去掉名字只要”1-12月的汇总值” ）
Split(d.keys 和 Items 该怎么写？

zllyyz

shiruiqiang 发表于 2024-1-12 11:37
褚老师的代码上修改一下就行

拆分字典.关键词后并输出Sheet1 n列后面 如何写表达式呢？？？

shiruiqiang

？？？？？？？？？？？？

zllyyz

shiruiqiang 发表于 2024-1-12 17:59
？？？？？？？？？？？？

你不是嵌套了三个字典（表名、姓名、行）吗，如何将字典拆分并输出呢

shiruiqiang

split(k,"|")(0),里面分别是0、1、2

zllyyz

shiruiqiang 发表于 2024-1-12 18:18
split(k,"|")(0),里面分别是0、1、2

可否在麻烦下 我写出来的输出后只有最后一个表名

shiruiqiang

褚老师的代码只有字典，判断数组=字典求和。

按照你的要求，需要字典嵌套。
目前是拿出字典

zllyyz

shiruiqiang 发表于 2024-1-12 19:31
褚老师的代码只有字典，判断数组=字典求和。

按照你的要求，需要字典嵌套。

原来我只是没定义数组的大小...弄半天一直提示出错 真菜呀

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr(1 To 1000, 1 To 13)
   
4.     Dim ws As Worksheet
   
5.     m = 0
   
6.     For Each ws In Worksheets
   
7.         With ws
   
8.             If .Range("a6") Like "*日期  姓名*" Then
   
9.                 r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
10.                 c = .Cells(6, .Columns.Count).End(xlToLeft).Column
    
11.                 arr = .Range("a6").Resize(r - 5, c)
    
12.                 For i = 3 To UBound(arr)
    
13.                     If Len(arr(i, 1)) <> 0 And arr(i, 1) <> "合计" Then
    
14.                         m = m + 1
    
15.                         brr(m, 1) = arr(i, 1)
    
16.                         For j = 2 To UBound(arr, 2)
    
17.                             If Len(arr(1, j)) <> 0 And IsDate(arr(1, j)) Then
    
18.                                 yf = Month(arr(1, j))
    
19.                                 brr(m, yf + 1) = brr(m, yf + 1) + arr(i, j)
    
20.                             End If
    
21.                         Next
    
22.                     End If
    
23.                 Next
    
24.             End If
    
25.         End With
    
26.     Next
    
27.     With Worksheets("sheet1")
    
28.         .Range("a5:m" & .Rows.Count).ClearContents
    
29.         .Range("a5").Resize(m, UBound(brr, 2)) = brr
    
30.     End With
    
31. End Sub
    

复制代码

chxw68

根据楼主的新要求，这个不需要用字典。