帖子: 69
主題: 16
精華: 0
積分: 84
點名: 0
作業系統: WIN7
軟體版本: EXCEL2010
閱讀權限: 20
註冊時間: 2016-3-20
最後登錄: 2024-4-24

論壇贊助勳章

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2023-6-21 14:34 | 只看該作者

[發問] 自動依照數量遞增序號

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

如附件

TEST序號1.rar (21.41 KB)

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

TEST序號.rar (21.21 KB)

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

5^#

發表於 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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

abc9gad2016

中學生 Rank: 2

帖子: 69
主題: 16
精華: 0
積分: 84
點名: 0
作業系統: WIN7
軟體版本: EXCEL2010
閱讀權限: 20
註冊時間: 2016-3-20
最後登錄: 2024-4-24

論壇贊助勳章

4^#

發表於 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

複製代碼

TOP

abc9gad2016

中學生 Rank: 2

帖子: 69
主題: 16
精華: 0
積分: 84
點名: 0
作業系統: WIN7
軟體版本: EXCEL2010
閱讀權限: 20
註冊時間: 2016-3-20
最後登錄: 2024-4-24

論壇贊助勳章

3^#

發表於 2023-6-21 17:20 | 只看該作者

回復 2# Andy2483

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

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

2^#

發表於 2023-6-21 16:02 | 只看該作者

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

回復 1# abc9gad2016

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

執行前:

執行結果:

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP