如何做跨頁出貨單歷史統計

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

1^# 跳轉到 »

發表於 2011-5-8 15:45 | 顯示全部帖子

本帖最後由 GBKEE 於 2011-5-8 20:01 編輯

回復 1# janejacky

更正:
試試看

Sub Ex()
Dim D(2) As Object, R As Variant, AR()
Set D(0) = CreateObject("Scripting.Dictionary")
Set D(1) = CreateObject("Scripting.Dictionary")
Set D(2) = CreateObject("Scripting.Dictionary")
With Sheets("出貨單")
For Each R In .Range(.[B12], .[G29]).Rows '出貨單內容範圍-> 的整列
If Application.CountA(R) = 6 Then '資料要齊全
AR = Array(.[G4].Text, .[G5], .[B5], R.Cells(1, 1), R.Cells(1, 2), R.Cells(1, 3), R.Cells(1, 5), R.Cells(1, 6))
D(1)(Join(AR, ",")) = AR
End If
Next
End With
With Sheets("出貨單歷史統計")
For Each R In .Range(.[A3], .Cells(Rows.Count, "H").End(xlUp)).Rows
If Application.CountA(R) = 8 Then D(0)(Join(Application.Transpose(Application.Transpose(R.Value)), ",")) = ""
D(2)(R.Cells(1, 1) & R.Cells(1, 2)) = D(2)(R.Cells(1, 1) & R.Cells(1, 2)) + R.Cells(1, 8)
Next
For Each R In D(1).KEYS
If D(0).EXISTS(R) = False Then
With .Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Resize(, 8) = D(1)(R)
D(2)(.Cells(1) & .Cells(1, 2)) = D(2)(.Cells(1) & .Cells(1, 2)) + .Cells(1, 8)
End With
End If
Next
For Each R In .Range(.[A3], .Cells(Rows.Count, "A").End(xlUp))
If D(2).EXISTS(R & R(1, 2)) Then R(1, 9) = D(2)(R & R(1, 2))
Next
End With
Set D(0) = Nothing
Set D(1) = Nothing
Set R = Nothing
End Sub

複製代碼

靜思自在 : 我們最大的敵人不是別人．可能是自己。