麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 自動依照數量遞增序號 [打印本頁]

作者: abc9gad2016 時間: 2023-6-21 14:34 標題: 自動依照數量遞增序號

小弟VBA還停留在錄製及修改程式的新手級階段
以下遇到問題無法錄製解決還請前輩指導

如附件[attach]36635[/attach]

請問要如何使用VBA將M~Q的資料，依序從C6開始，依照機種、數量把"序號-前"依序遞增上去
完成後SHEET2的樣子感謝。

作者: Andy2483 時間: 2023-6-21 16:02

本帖最後由 Andy2483 於 2023-6-21 16:23 編輯

回復 1# abc9gad2016

謝謝前輩發表此主題與範例
後學藉此帖練習VBA陣列,學習方案如下,請前輩參考

執行前:
[attach]36636[/attach]

執行結果:
[attach]36637[/attach]

Option Explicit
Sub TEST()
Dim Brr, Crr, V&, i&, R, N&, S%
Brr = Range([序號新增!Q3], [序號新增!M65536].End(xlUp))
ReDim Crr(1 To 60000, 1 To 11)
For i = 1 To UBound(Brr)
S = IIf(Brr(i, 2) <= Brr(i, 3), 1, -1)
For R = Val(Brr(i, 2)) To Val(Brr(i, 3)) Step S
   V = V + 1
   N = N + 1
   Crr(V, 1) = N
   Crr(V, 3) = Brr(i, 1)
   Crr(V, 4) = R
   Crr(V, 11) = Brr(i, 5)
Next
N = 0
Next
If V = 0 Then Exit Sub
Sheets("序號新增").UsedRange.Offset(5, 0).Delete
With Sheets("序號新增").[A6].Resize(V, 11)
.Value = Crr
With .Columns(6)
   .Value = "=IF(E6="""","""",RIGHT(E6,5)-RIGHT(D6,5)+1)"
End With
Application.Goto .Item(6)
End With
Erase Brr, Crr
End Sub

作者: abc9gad2016 時間: 2023-6-21 17:20

回復 2# Andy2483

太感謝前輩了~測試修改目前都可以運用，請問這是怎麼寫的呢，如果有餘裕的話希望可以加上每一行註解，讓我參考學習感謝感謝

作者: abc9gad2016 時間: 2023-6-21 17:55

有詢問到另一位前輩此方法程式更簡便，可惜序號不會自動跑出，資質駑鈍不知道該如何修改

Sub sdyt()
For k = 3 To 5
For i = 1 To Range("p" & k).Value
Range("a" & i + 5 + r) = i
Range("c" & i + 5 + r) = Range("M" & k).Value
Range("D" & i + 5 + r) = Range("N" & k).Value + Range("a" & i + 5 + r) - 1
Next
r = r + i - 1
Next
End Sub

複製代碼

作者: Andy2483 時間: 2023-6-26 07:47

本帖最後由 Andy2483 於 2023-6-26 07:49 編輯

回復 3# abc9gad2016

謝謝前輩回復,歡迎前輩常上論壇一起學習

以下是今天後學複習的心得註解,請前輩參考,請各位前輩指教

Option Explicit
Sub TEST()
Dim Brr, Crr, V&, i&, R, N&, S%
'↑宣告變數(&是長整數,%是短整數,沒有帶符號的是通用型變數)
Brr = Range([序號新增!Q3], [序號新增!M65536].End(xlUp))
'↑令Brr變數是二維陣列,以M~Q欄儲存格值帶入陣列中
ReDim Crr(1 To 60000, 1 To 11)
'↑令Crr變數是二維空陣列,縱向範圍1~6萬索引號,橫向範圍1~11索引號
For i = 1 To UBound(Brr)
'↑設順迴圈,i從1到Brr陣列縱向最大索引列號
S = IIf(Brr(i, 2) <= Brr(i, 3), 1, -1)
'↑令S變數是 1或 -1
For R = Val(Brr(i, 2)) To Val(Brr(i, 3)) Step S
'↑設順迴圈,R從Brr陣列值(序號-前到序號-後),迴圈級距是 S變數
   V = V + 1
   '↑令V變數累加1 (這是要記錄累計的陣列索引列號)
   N = N + 1
   '↑令N變數累加1 (這是要累計項次欄的項次)
   Crr(V, 1) = N
   '↑令Crr陣列(累計的陣列索引列號,第1欄)陣列值是 N變數
   Crr(V, 3) = Brr(i, 1)
   '↑令Crr陣列(累計的陣列索引列號,第3欄)陣列值是 ,
   '是i迴圈第1欄Brr陣列值(機種)
   Crr(V, 4) = R
   '↑令Crr陣列(累計的陣列索引列號,第4欄)陣列值是 R迴圈數
   Crr(V, 11) = Brr(i, 5)
   '↑令Crr陣列(累計的陣列索引列號,第11欄)陣列值是 (版本)
Next
N = 0
'↑令N變數歸零 (項次歸零)
Next
If V = 0 Then Exit Sub
'↑令如果沒有資料就結束程式執行
Sheets("序號新增").UsedRange.Offset(5, 0).Delete
'↑令舊資料刪除
With Sheets("序號新增").[A6].Resize(V, 11)
'↑以下是關於從[A6]儲存格開始擴展必要儲存格範圍的程序
.Value = Crr
'↑令儲存格值是 Crr陣列值
With .Columns(6)
'↑以下是這範圍儲存格第6欄的程序
   .Value = "=IF(E6="""","""",RIGHT(E6,5)-RIGHT(D6,5)+1)"
   '↑令這第6欄值是公式~~ (PS:只要給第1列的公式,EXCEL會自動下刷)
End With
Application.Goto .Item(6)
End With
Erase Brr, Crr
'↑令釋放變數
End Sub

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)