汇总表格

ylj112113

附件为两个表格，要把次品返修品里面的10.1-10.29汇总到不良月汇总表格，有没有快速的方法？在此先谢谢大家！！！

sdong7

不良汇总表中日期改为i2014.10.1，2014.10.2,主要是要与各分表中名字一致

sdong7

Sub tt() 'by sdong7 20141031
Dim mxr1, mxr2 As Long
Dim arr1, arr2, dic, arr3(1 To 1000000, 1 To 2)
mxr1 = Sheets("sheet1").[a1048576].End(xlUp).Row
arr1 = Sheets("sheet1").Range("a1:aa" & mxr1)
Set dic = CreateObject("scripting.dictionary")

Workbooks.Open (ThisWorkbook.Path & "\次品返修品统计报表.xls")
Dim sht As Worksheet
For Each sht In Worksheets
mxr2 = Sheets(sht.Name).[a65536].End(xlUp).Row
arr2 = Sheets(sht.Name).Range("a1:c" & mxr2)
For i = 2 To mxr2
If dic.exists("2014." & sht.Name & arr2(i, 1) & arr2(i, 2)) Then
hang = dic("2014." & sht.Name & arr2(i, 1) & arr2(i, 2))
arr3(hang, 2) = arr3(hang, 2) + arr2(i, 3)
Else
k = k + 1
dic("2014." & sht.Name & arr2(i, 1) & arr2(i, 2)) = k
arr3(k, 1) = "2014." & sht.Name & arr2(i, 1) & arr2(i, 2)
arr3(k, 2) = arr2(i, 3)
End If
Next i
Erase arr2
Next
Workbooks("次品返修品统计报表.xls").Close
For i = 3 To mxr1
For j = 3 To 27
If dic.exists(arr1(i, 2) & arr1(i, 1) & arr1(2, j)) Then
m = dic(arr1(i, 2) & arr1(i, 1) & arr1(2, j))
arr1(i, j) = arr1(i, j) + arr3(m, 2)
End If
Next j

Next i

Sheets("sheet1").Range("a1:aa" & mxr1) = arr1

End Sub

sdong7

传上附件！！！！！！!!!

sdong7

如果觉得好就送朵鲜花！！，注意你汇总表内的日期格式要与分表一致(2014.10.1是正确的！！！

ylj112113

sdong7 发表于 2014-10-31 12:25
传上附件！！！！！！!!!

你这个附件点里面的PUN按钮会弹出无法运行，所有宏被禁用，但我用你里面的代码运行时会弹出类型不匹配，不知是何原因？不过还是非常感谢你！对了还有若要把表格里面一样的花纹按顺序汇总到一起，为啥用排序时，花纹那列可以实现同花纹归到一起但其它列就不行？对了送花要什么送？呵呵，我是新手啥都不懂！谢谢！

tabbaco

sdong7 发表于 2014-10-31 12:22
不良汇总表中日期改为i2014.10.1，2014.10.2,主要是要与各分表中名字一致

您好，我发了个帖子向您求助，不知您看到了没有？您之前给我编的宏运行时出错了，可否再帮我看下能否解决。非常感谢~~新发帖地址