標題: 自動編號問題 [打印本頁]

---

作者: hcy_tp    時間: 2010-11-3 09:14     標題: 自動編號問題

[attach]3466[/attach]各位先進們好！
雖然可以使用函數完成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    時間: 2010-11-3 10:02

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    時間: 2010-11-3 13:47

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

---

作者: oobird    時間: 2010-11-3 22:44

做成Worksheet_Change事件即可。

---

作者: hcy_tp    時間: 2010-11-4 07:21

謝謝您的建議
已經程式略調整成
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    時間: 2010-11-4 08:41

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

---

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