- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-12-5
|
本帖最後由 Andy2483 於 2023-11-21 10:04 編輯
回復 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 |
|
發表於 2023-11-21 08:03
| 