[已解决]汇总数据

王英wang

  要求：现在是4月，要求将表“IODC”和表"EFPR"3月的数据汇总到，“汇总”表里
  备注：有料号相同项就合并计算，如果是空格删除


请各位老师帮帮忙，谢谢。
  

[/td] [/tr]

最佳答案

月排行榜 / 总排行榜

grf1973

2017-4-24 09:30

1. Sub 汇总()
   
2.     yf = Month(Date) - 1   '上一月
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For k = 1 To 2
   
5.         With Sheets(k)
   
6.             r = .UsedRange.Find("料号").Row
   
7.             If k = 1 Then
   
8.                 For c = .Cells(r, 256).End(xlToLeft).Column To 2 Step -1
   
9.                     If Month(.Cells(r, c)) = yf Then Exit For
   
10.                 Next
    
11.             Else
    
12.                 For c = .Cells(r, 256).End(xlToLeft).Column To 2 Step -1
    
13.                     If .Cells(r, c) = yf & "月" Then Exit For
    
14.                 Next
    
15.             End If
    
16.             For i = r + 1 To .[a65536].End(3).Row
    
17.                 x = .Cells(i, 1)
    
18.                 d(x) = d(x) + .Cells(i, c)
    
19.             Next
    
20.         End With
    
21.     Next
    
22.     For Each x In d.keys
    
23.         If d(x) = 0 Then d.Remove (x)
    
24.     Next
    
25.     [a2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    
26.     [a2].Resize(d.Count, 2).Sort key1:=[b2], order1:=xlDescending
    
27. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 汇总()
   
2.     yf = Month(Date) - 1   '上一月
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For k = 1 To 2
   
5.         With Sheets(k)
   
6.             r = .UsedRange.Find("料号").Row
   
7.             If k = 1 Then
   
8.                 For c = .Cells(r, 256).End(xlToLeft).Column To 2 Step -1
   
9.                     If Month(.Cells(r, c)) = yf Then Exit For
   
10.                 Next
    
11.             Else
    
12.                 For c = .Cells(r, 256).End(xlToLeft).Column To 2 Step -1
    
13.                     If .Cells(r, c) = yf & "月" Then Exit For
    
14.                 Next
    
15.             End If
    
16.             For i = r + 1 To .[a65536].End(3).Row
    
17.                 x = .Cells(i, 1)
    
18.                 d(x) = d(x) + .Cells(i, c)
    
19.             Next
    
20.         End With
    
21.     Next
    
22.     For Each x In d.keys
    
23.         If d(x) = 0 Then d.Remove (x)
    
24.     Next
    
25.     [a2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    
26.     [a2].Resize(d.Count, 2).Sort key1:=[b2], order1:=xlDescending
    
27. End Sub

复制代码

王英wang

grf1973 发表于 2017-4-24 09:30

非常感谢老师的帮助，谢谢

王英wang

grf1973 发表于 2017-4-24 09:30

你好，我把代码放到其它工作表就下标越界，是怎么回事？
我要汇总工作表3,4，我也改啦 for 3 to 4，但是怎么执行不了呢

grf1973

sheets(k)是工作表的索引号，for k=3 to 4 ，那么要引用的表就是第3，第4张工作表。
另外由于两张表的格式不同，所以要注意表和代码相对应（表1里的“3月”是日期，表2里的“3月”是字符串）

王英wang

grf1973 发表于 2017-4-24 10:33
sheets(k)是工作表的索引号，for k=3 to 4 ，那么要引用的表就是第3，第4张工作表。
另外由于两张表的格式 ...

非常感谢，谢谢{:1112:}

liuym

下载学习学习了，