返回列表 上一主題 發帖

[發問] TextBox顯示自動編號問題請教﹖

回復 2# luhpro
另一寫法
UserForm模組
  1. Option Explicit
  2. Dim D As Object
  3. Private Sub UserForm_Initialize()
  4.     txt編號 = 編號
  5. End Sub
  6. Private Sub cb輸入_Click()
  7.     With Sheets("工作表1")
  8.         If Application.CountIf(.Range("a:a"), txt編號) > 0 And txt編號 <> "" Then
  9.             MsgBox "編號已存在!", vbCritical, "錯誤"
  10.             Exit Sub
  11.         ElseIf UBound(Split(txt編號, "-")) = 0 Or txt編號 = "" Then
  12.             MsgBox "編號 格式 錯誤!", vbCritical, "錯誤"
  13.             Exit Sub
  14.         ElseIf UCase(txt編號) <> "AL-" & Format(Application.Max(D.KEYS) + 1, "000") Then
  15.             MsgBox txt編號 & " 需是 " & "AL-" & Format(Application.Max(D.KEYS) + 1, "000"), vbCritical, "錯誤"
  16.             Exit Sub
  17.         End If
  18.         .Range("A65536").End(xlUp).Cells(2) = txt編號
  19.         D(Application.Max(D.KEYS) + 1) = ""
  20.     End With
  21. End Sub
  22. Private Sub CommandButton2_Click() 'cb輸入後,可繼續 + 1
  23.     txt編號 = "AL-" & Format(Application.Max(D.KEYS) + 1, "000")
  24. End Sub
  25. Private Function 編號() As String
  26.     Dim E As Range
  27.     Set D = CreateObject("SCRIPTING.DICTIONARY")
  28.     For Each E In 工作表1.Range("A:A").SpecialCells(xlCellTypeConstants)
  29.         If UBound(Split(E, "-")) > 0 Then D(Val(Split(E, "-")(1))) = ""
  30.     Next
  31.     If D.Count = 0 Then
  32.         編號 = "AL-001"
  33.         D(0) = ""
  34.     Else
  35.         編號 = "AL-" & Format(Application.Max(D.KEYS) + 1, "000")
  36.     End If
  37. End Function
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 6# ann.liu

表單如果要連續輸入好幾筆,是否可以自動進位呢
試試看
  1. Private Sub cb輸入_Click()
  2.     With Sheets("工作表1")
  3.         If Application.CountIf(.Range("a:a"), txt編號) > 0 And txt編號 <> "" Then
  4.             MsgBox "編號已存在!", vbCritical, "錯誤"
  5.             Exit Sub
  6.         ElseIf UBound(Split(txt編號, "-")) = 0 Or txt編號 = "" Then
  7.             MsgBox "編號 格式 錯誤!", vbCritical, "錯誤"
  8.             Exit Sub
  9.         ElseIf UCase(txt編號) <> "AL-" & Format(Application.Max(D.KEYS) + 1, "000") Then
  10.             MsgBox txt編號 & " 需是 " & "AL-" & Format(Application.Max(D.KEYS) + 1, "000"), vbCritical, "錯誤"
  11.             Exit Sub
  12.         End If
  13.         .Range("A65536").End(xlUp).Cells(2) = txt編號
  14.         D(Application.Max(D.KEYS) + 1) = ""
  15.         txt編號 = "AL-" & Format(Application.Max(D.KEYS), "000")
  16.     End With
  17. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題