返回列表 上一主題 發帖

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

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

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

如附件 TEST序號1.rar (21.41 KB)

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

TEST序號.rar (21.21 KB)

本帖最後由 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

回復 2# Andy2483


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

TOP

有詢問到另一位前輩此方法程式更簡便,可惜序號不會自動跑出,資質駑鈍不知道該如何修改
  1. Sub sdyt()
  2. For k = 3 To 5
  3.     For i = 1 To Range("p" & k).Value
  4.         Range("a" & i + 5 + r) = i
  5.         Range("c" & i + 5 + r) = Range("M" & k).Value
  6.         Range("D" & i + 5 + r) = Range("N" & k).Value + Range("a" & i + 5 + r) - 1
  7.     Next
  8.     r = r + i - 1
  9.   Next
  10. End Sub
複製代碼

TOP

本帖最後由 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

        靜思自在 : 要批評別人時,先想想自己是否完美無缺。
返回列表 上一主題