Sub 取出N03等進出貨及算留存()
Dim N, B, i%, C%, R%, Cn%, Arr, Brr, Crr
Set d = CreateObject("scripting.dictionary")
N = Array(0, 4, 5, 7, 19, 20, 24) '取得資料的欄號，因陣列從0開始，補一個"0"
Arr = Range([歷史採購!X4], [歷史採購!D4].End(4))
Brr = Range([取出資料!B2], [取出資料!A1].End(4))
For i = 1 To UBound(Arr)
d(Arr(i, 1) & "") = d(Arr(i, 1) & "") & "," & i '用字典記錄逐一取出現列號
Next i
Sheets("取出資料").Activate
Ri = 2 'Ri= 貼上資料的起始列號.且以後會固定跳7列 (6列為資料區,第7列為空白列)
Columns("E:I").Clear '清空資料&格式
For i = 1 To UBound(Brr) '依序依編號(N03,…)用來產製Crr陣列(由Arr對應欄/列取資料)
B = Split(d(Brr(i, 1) & ""), ",") ‘ 分割取得該編號及其出現的列號 ---註1
Cn = UBound(B) ‘即同一編號出現的最高次數賦值給Cn ,可能為1或2或…
Crr = Cells(Ri, 5).Resize(6, Cn) ‘固定寫入6列,欄數則視出現次數來決定
For C = 1 To Cn ‘Cn =1時表示該編號只出現1次 Cn會決定Crr區域大小及外迴圈次數
For R = 1 To 6 ‘C只要每循環一次,R要跑6次(即逐一取6個不同欄位寫在1~6列)
Crr(R, C) = Arr(B(C), N(R) - 3) ‘逐一從Arr取出各對應欄之資料寫入Crr
If R = 3 Then Crr(R, C) = "有:" & Crr(R, C)
If R = 4 Then Crr(R, C) = "出:" & Crr(R, C) & "箱"
If R = 5 Then Crr(R, C) = "留:" & Crr(R, C) & "箱"
Next R
Next C
With Cells(Ri, 5).Resize(6, Cn) '把Crr資料放到工作表+設定儲存格格式
.Value = Crr
.Borders.LineStyle = xlContinuous
End With
Ri = Ri + 7
Next i
Columns("E:I").AutoFit '自動欄寬
End Sub
