- 帖子
- 36
- 主題
- 7
- 精華
- 0
- 積分
- 77
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- MICROSOFT
- 閱讀權限
- 20
- 註冊時間
- 2015-6-7
- 最後登錄
- 2024-9-22
 
|
5#
發表於 2018-11-11 12:34
| 只看該作者
回復 4# 千暉尋
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
註1:以N03為例,出現的列號分別為1,7,12,18,23共5次,則d(Arr(i, 1) & "") = d(Arr(i, 1) & "") & "," & i跑完的結果為:N03, 1,7,12,18,23
再經B = Split(d(Brr(i, 1) & ""), ",") 分割的結果:B(0)=”N03”, B(1)= 1,B(2)=7, B(3)=12…
B(1), B(2)..即為該編號所在列號,且B的元素個數會隨各個編號在Arr出現次數而變
Crr(R, C) = Arr(B(C), N(R) - 3) ‘固定寫6列,但寫多少欄則視外迴圈跑的次數而定.
N = Array(0, 4, 5, 7, 19, 20, 24) '取得資料的欄號,但資料不是從A1寫入,而是從D4寫入,所以要減去3 故N(R) – 3 會逐一取得1,2,3,16,17,21 即為Arr區域要取資料的對應欄位
感謝阿龍大大的程式碼,很及時且精準的解決了我的需求,以上是我參研了一晚的心得,讓我對陣列和字典又有更深一層的了解和掌握,將自己理解的部份寫在上面分享,其中如有理解不足或謬誤的地方,請各位大師不吝賜教. |
|
