自動編號問題

hcy_tp

Book1.rar (8.51 KB)

下載次數: 8

2010-11-3 09:14

各位先進們好！
雖然可以使用函數完成B欄位的自動編碼，
但請先進們可否用VBA程式來執行。
案號                   案次
RM960101        RM960101-1
RM960101        RM960101-2
RM960102        RM960102-1
RM960103        RM960103-1
RM960103        RM960103-2
RM960104        RM960104-1
RM960105        RM960105-1
RM960105        RM960105-2

oobird

1. Sub yy()
   
2. Dim d As Object, rng, i%
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. rng = Range([a2], "b" & [a65536].End(3).Row)
   
5. For i = 1 To UBound(rng)
   
6. d(rng(i, 1)) = d(rng(i, 1)) + 1
   
7. rng(i, 2) = rng(i, 1) & "-" & d(rng(i, 1))
   
8. Next
   
9. [b2].Resize(i - 1, 1) = Application.Index(rng, , 2)
   
10. End Sub

複製代碼

hcy_tp

感謝您的協助，
不過有幾個問題想詢問一下
1.可以只設定工作表Sheet1自己自動執行嗎？
2.有可能讓a欄位有變動時再調整嗎？例如a4有資料輸入b4才會執行，不用讓全部的欄位都重新跑過。

oobird

做成Worksheet_Change事件即可。

hcy_tp

謝謝您的建議
已經程式略調整成
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim d As Object, rng, i%
Set d = CreateObject("Scripting.Dictionary")
rng = Range([a2], "b" & [a65536].End(3).Row)
For i = 1 To UBound(rng)
d(rng(i, 1)) = d(rng(i, 1)) + 1
rng(i, 2) = rng(i, 1) & "-" & d(rng(i, 1))
Next
[b2].Resize(i - 1, 1) = Application.Index(rng, , 2)

End Sub
目前測試ok
謝謝您的幫忙

oobird

目前測試ok？
這樣還不是全部欄位重跑一遍？