- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
20#
發表於 2024-3-12 08:36
| 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
總表:
執行結果A001:
執行結果A002:
執行結果A003:
Option Explicit
'這方案是以字典key記錄不重複的貨號,item記錄相同貨號所在列號,以"/"間隔
Sub TEST_1()
Application.DisplayAlerts = False
'↑令不必詢問工作表是否刪除,直接刪了
Dim Brr, Crr, Z, Q, A, i&, j%, s%, N%
'↑宣告變數:&是長整數,%是短整數,其餘是通用變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是 字典
For Each A In Worksheets
If A.Name <> "總表" Then A.Delete
Next
'↑設順迴圈將"總表"以外的工作表刪除
Brr = [A1].CurrentRegion: Crr = Brr
'↑令Brr變數是帶入區域儲存格值的二維陣列,令Crr變數同Brr陣列
For i = 3 To UBound(Brr): Z(Brr(i, 2)) = Z(Brr(i, 2)) & "/" & i: Next
'↑設順迴圈將貨號濾重複,但是以item記錄所在的列號,以"/"符號間隔
For s = 0 To Z.Count - 1
Q = Split(Z.ITEMS()(s), "/"): N = 2
For i = 1 To UBound(Q)
N = N + 1
For j = 1 To 8: Crr(N, j) = Brr(Q(i), j): Next
Next
Worksheets.Add.Name = Z.KEYS()(s): [A1].Resize(N, 8) = Crr
Next
'↑設順迴圈將以每個貨號新增工作表,將資料寫入工作表中
End Sub |
|
發表於 2013-9-6 08:36
| 
