Andy2483

回復 2# 准提部林


    謝謝論壇,謝謝前輩指導
後學藉此帖學習前輩的方案,以下是心得註解,請前輩再指導

Sub TEST_A01()
Dim Arr, Brr, i&, V1&, V2&, N&, j%, k%, x%
'↑宣告變數:(Arr, Brr)通用型,(i,V1,V2,N)長整數,(j,k,x)短整數
Arr = Sheets("Sheet1").UsedRange
'↑令Arr變數是二維陣列,以儲存格值帶入陣列中
ReDim Brr(1 To 20000, 1 To 6)
'↑宣告Brr變數是 二維空陣列,縱向1~20000,橫向1~6
For x = 1 To 6: Brr(1, x) = Arr(1, x): Next
'↑設順迴圈!x從1~6,將Arr陣列第1列資料帶入 Brr陣列第1列中
For i = 2 To UBound(Arr)
'↑設順迴圈!i從2到 Arr陣列縱向最大索引列號
    V1 = Int((Arr(i, 4) - 1) / Arr(i, 9))
    '↑令V1變數是 (i迴圈列4欄Arr陣列值-1)除以 i迴圈列9欄Arr陣列值,
    '最後去除小數的整數
    V2 = Arr(i, 4) - V1 * Arr(i, 9)
    '↑令V2變數是 i迴圈列4欄Arr陣列值-(V1變數*i迴圈列9欄Arr陣列值)
    For j = 12 To UBound(Arr, 2)
    '↑設順迴圈!j從12到 Arr陣列橫向最大索引欄號
        If Arr(i, j) = "" Then GoTo j01
        '↑如果i迴圈列j迴圈欄Arr陣列值是空字元?
        'True就跳到標示j01位置繼續執行
        For k = 1 To V1 + 1
        '↑設順迴圈!k從1 到(V1變數+1)
            N = N + 1
            '↑令N變數累加1
            For x = 2 To 6: Brr(N + 1, x) = Arr(i, x): Next
            '↑將Arr陣列i迴圈列(2~6)欄資料帶入 Brr陣列下方空白列
            Brr(N + 1, 1) = Arr(i, j)
            '↑令(N+1)列第1欄Brr陣列值是 i迴圈列j迴圈欄Arr陣列值
            Brr(N + 1, 4) = IIf(k > V1, V2, Arr(i, 9))
            '↑令(N+1)列第4欄Brr陣列值是 IIF()回傳值:
            '如果k變數大於V1變數,回傳V2變數,
            '否則回傳 i迴圈列9欄Arr陣列值
        Next k
j01: Next j
Next i
With Sheets.Add
'↑以下是關於 新增一個工作表後的程序
     .[A1].Resize(N + 1, 6) = Brr
     '↑令該新表[A1]擴展向下(N+1)列,向右擴展6欄儲存格值以Brr陣列帶入
     .Name = Format(Now, "yyyymmdd-hhmmss")
     '↑令該新表表名是當下時間經格式化為指定文字格式的字串
End With
End Sub
'=================================================
'以下是字典,Do Until的練習,請前輩再指導
Option Explicit
Sub TEST()
Dim Brr, Crr, Arr, V&, V2&, Z, i&, j%, R&, c%, T$
Set Z = CreateObject("Scripting.Dictionary")
Brr = Intersect(Sheet2.UsedRange, [H:IV])
For i = 2 To UBound(Brr): Z(Brr(i, 1)) = i: Next
Crr = Range([F1], [B65536].End(3)(1, 0))
ReDim Arr(20000, 1 To 6)
For j = 1 To 6: Arr(0, j) = Crr(1, j): Next
For i = 2 To UBound(Crr)
   T = Crr(i, 2): Z(T & "qty") = Val(Crr(i, 4))
   V2 = Brr(Z(T), 2): c = 0
   Do Until c = Brr(Z(T), 4)
      V = Z(T & "qty")
      Do Until V < 0
         R = R + 1
         For j = 2 To 6: Arr(R, j) = Crr(i, j): Next
         Arr(R, 1) = Brr(Z(T), 5 + c)
         Arr(R, 4) = IIf(V - V2 > 0, V2, V)
         V = V - V2
      Loop
      c = c + 1
   Loop
Next
With Sheets.Add
   .[A1].Resize(R + 1, 6) = Arr
   .Name = Format(Now, "yyyymmdd-hhmmss")
End With
End Sub