帮忙修改代码，有关多表汇总问题

sulli112

我想将附件里面已用行数的表行汇总在统计那个表中，数据不用合并，只是将除统计表外的已用行数复制过去，我里面有附代码，但是合并完，实收那栏的数据与另外两张表实收数据合并对等不上，麻烦帮忙看一下是什么问题，谢谢

sulli112

sulli112

1. Sub AwTest2222()
   
2.     Dim i%, j%, iRow%, s&, sr$, ws As Worksheet, arr, d As Object
   
3.     Set d = CreateObject("Scripting.Dictionary") '创建字典对象，并把字典对象赋给变量d。这是最常用的一句代码。所谓的“后期绑定”。用了这句代码就不用先引用c:\windows\system32\scrrun.dll了
   
4.     For Each ws In Sheets
   
5.         If ws.Name <> "汇总表" And ws.Name <> "总表" And ws.Name <> "汇总" And ws.Name <> "求和" Then
   
6.             arr = ws.[a1].CurrentRegion '本示例假定在工作表 Sheet1 中有一个包含标题行的表。本示例选定该表，但不选定标题行
   
7.             For i = 2 To UBound(arr)
   
8.                 d(ws.Name & "|" & arr(i, 3)) = ""
   
9.             Next
   
10.         End If
    
11.     Next
    
12.     arr = Sheets("汇总表").[a1].CurrentRegion
    
13.     For i = 2 To UBound(arr)
    
14.         If Not d.exists(arr(i, 4) & "|" & arr(i, 3)) Then 'arr(i, 4)/arr(i,3)值 的内容不存在D字典中”，那么执行下面的语句
    
15.             For Each ws In Sheets
    
16.                 If ws.Name = arr(i, 4) Then '如果D列班级等于表名，然后
    
17.                     iRow = ws.Cells(Rows.Count, 3).End(3).Row '整体意思是第三列姓名最后一个有数据的行的行号
    
18.                     For j = 1 To 4
    
19.                         ws.Cells(iRow + 1, j) = arr(i, j) '如果没有则新建一行等于新数组
    
20.                     Next
    
21.                 End If
    
22.             Next
    
23.         End If
    
24.     Next
    
25.     For i = 2 To UBound(arr) '第2行到最后一行
    
26.         For j = 5 To UBound(arr, 2)
    
27.             If arr(i, j) > 0 Then '如果(arr(i, 1))单元格的内容长度大于0
    
28.                 sr = arr(i, 4) & "|" & arr(i, 3) & "|" & arr(1, j)
    
29.                 d(sr) = arr(i, j) '就将arr(i, 1))单元格的内容做为关建字加入字典
    
30.             End If
    
31.         Next
    
32.     Next
    
33.    For Each ws In Sheets
    
34.          If ws.Name <> "汇总表" And ws.Name <> "总表" And ws.Name <> "汇总" And ws.Name <> "求和" Then
    
35.             arr = ws.[a1].CurrentRegion
    
36.             For i = 2 To UBound(arr)
    
37.                 s = 0
    
38.                 For j = 5 To 11
    
39.                     sr = ws.Name & "|" & arr(i, 3) & "|" & arr(1, j)
    
40.                     If d.exists(sr) Then arr(i, j) = d(sr)
    
41.                     s = s + Val(arr(i, j))
    
42.                     arr(i, 12) = s
    
43.                     arr(i, 14) = arr(i, 12) - arr(i, 13)
    
44.                 Next
    
45.             Next
    
46.             ws.[a1].CurrentRegion = arr
    
47.         End If
    
48.     Next
    
49. End Sub
    

复制代码