Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典另一方案,學習方案與心得如下,請各位前輩指教

Option Explicit
'這方案是以字典key記錄不重複的貨號,item為二維陣列,
'另以貨號連接"/r"字串為key,item為該二維陣列已使用的列數
Sub TEST_2()
Application.DisplayAlerts = False
Dim Brr, Crr(1 To 1000, 1 To 8), Z, Q, A, R&, i&, j%, s%, N%
Set Z = CreateObject("Scripting.Dictionary")
For Each A In Worksheets
   If A.Name <> "總表" Then A.Delete
Next
Brr = [A1].CurrentRegion
For i = 3 To UBound(Brr)
   A = Z(Brr(i, 2)): R = Z(Brr(i, 2) & "/r") + 1
   '迴圈一開始:
   'A = Z(Brr(i, 2))這程序執行就已經在Z字典裡產生了key是 Brr(i, 2)陣列值,
   '而這對應item是空的,程序意義是令以A變數是 迴圈貨號為key將item二維陣列提取出來,
   '如果item不是二維陣列也沒差!
   '因為A變數宣告的是通用型變數,可以隨需求作變換(畢竟一開始的字典裡哪來的二維陣列)
   
   'R = Z(Brr(i, 2) & "/r") + 1這程序執行後已經就已經在Z字典裡產生了key是
   'Brr(i, 2)陣列值連接"/r"新字串,而這對應item +1,程序意義是:
   '令R變數是 貨號連接"/r"字串的key,item是自身值+1(這是要寫入二維陣列的空列號)
   '至此會有個疑問,A變數都還不是陣列! 哪裡來的空列??
   'A變數還不是陣列也沒差,後方程序判斷式會建立新二維陣列,
   'R變數宣告的是 長整數,其初始值是0,再+1=1,所以剛好指定其要寫入空列號是第1列
      
   If Not IsArray(A) Then A = Crr
   '↑如果A變數不是陣列,就令A是同Crr變數的二維陣列
   '至此每個i迴圈都以貨號當key,item是裝結果資料的二維陣列,貨號連接"/r"字串記錄該
   '二維陣列用到哪一列了
   For j = 1 To 8: A(R, j) = Brr(i, j): Next
   Z(Brr(i, 2)) = A: Z(Brr(i, 2) & "/r") = R
Next
'↑藉著將二維陣列在item置入/提取/編輯/放回達到目的,至於為何要提取出來再編輯?
'VBA規則:字典裡的陣列要編輯需提取出來再放回,無法直接在字典裡編輯
For Each A In Z.keys
   If Not IsArray(Z(A)) Then GoTo A01
   Worksheets.Add.Name = A
   [A1:H1].Resize(2) = Brr
   [A3].Resize(Z(A & "/r"), 8) = Z(A)
A01: Next
'↑設逐項迴圈將字典裡的二維陣列寫入新增工作表裡
End Sub

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下:

Option Explicit
'這方案是以字典key記錄不重複的貨號,item為儲存格集
Sub TEST_3()
Application.DisplayAlerts = False
Dim Brr, A, Z, Q, i&, T$
Set Z = CreateObject("Scripting.Dictionary")
For Each A In Worksheets
   If A.Name <> "總表" Then A.Delete
Next
Brr = [A1].CurrentRegion
For i = 3 To UBound(Brr)
   T = Brr(i, 2)
   If Not IsObject(Z(T)) Then
      Set Z(T) = Union([A1:A2], Cells(i, 2))
      Else
      Set Z(T) = Union(Z(T), Cells(i, 2))
   End If
Next
For Each Q In Z.keys
   Worksheets.Add.Name = Q
   Z(Q).EntireRow.Copy [A1]
Next
End Sub