- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 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
|
|
發表於 2011-5-8 11:37
| 
