返回列表 上一主題 發帖

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

ann.liu

帖子
16 
主題
4 
精華
0 
積分
26 
點名
0  
作業系統
WINDOWN XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
女 
來自
TW 
註冊時間
2011-5-11 
最後登錄
2017-12-17 

論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2014-10-28 22:44 | 只看該作者

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

請教各位大大：
是否可以在TextBox顯示A:A最後一個編號再+1
點選CommandButton1後將TextBox顯示的資料COPY到工作表1
附件如下：
TEXT.rar (8.78 KB)
收藏 分享
ANN

ann.liu

帖子
16 
主題
4 
精華
0 
積分
26 
點名
0  
作業系統
WINDOWN XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
女 
來自
TW 
註冊時間
2011-5-11 
最後登錄
2017-12-17 

論壇贊助勳章
10#
發表於 2014-11-4 20:02 | 只看該作者
感謝luhpro大大：
你的寫法測試後，真是讓我太佩服了，雖然程式不是很了解，
但會努力的研究，檔案就先收下，慢慢研究了，感恩。
ANN

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
9#
發表於 2014-11-2 22:49 | 只看該作者
本帖最後由 luhpro 於 2014-11-2 22:52 編輯
1.如果我有4個UserForm 都要自動編號，編號都要自動帶出，
我重新製作另外三個表單，但號碼會亂跳，不知錯誤在那，請大大指教﹖
2.我做了4個按鈕點選需要的表單，不要開始excel就自動跳出視窗，
請問大大要如何編寫呢﹖
3.日期顯示可以加上時間嗎﹖
Me.lbl建立日期 = Format(Application.VLookup(Me.cmb編號, Worksheets("工作表1").[編號], 2, 0) , "yyyy/m/d") ...
ann.liu 發表於 2014-10-31 09:36

我重做了.
1. 刪除 開啟表格 工作表, 刪除其他多的 UserForm, 只保留一個 UserForm 實現相關功能, 保留日後新增工作表的彈性, 只要名稱開頭為 "工作表" 就會自動加入選擇序列, 目前可在 Userform 上直接切換工作表與增號.
2. 啟動 UserForm 按鈕放在上方 功能表區 中 說明 的右邊, 那個按鈕點一下即可開啟 UserForm.
3. 因為你沒有說明日期時間取值的標準,我直接帶入目前時間.
4. 在工作表選單切換時, 各工作表中 B1 的值會帶到 姓名 標題欄, 保留彈性調整顯示的可能性.
5. 新增的工作表須自行輸入 A1,B1,C1 的標題名稱, A2 則輸入新的編號
6. 部分地方可能還有 BUG ,時間不夠來不及一一測試.
ufTar (UserForm)
  1. Private Sub cbSheet_Change()
  2.   Dim bNFind As Boolean
  3.   Dim vA
  4.   
  5.   bNFind = True
  6.   For Each vA In ufTar.cbSheet.List
  7.     If vA = ActiveSheet.Name Then bNFind = False
  8.   Next
  9.   If bNFind Then GetSht
  10.   SetForm
  11. End Sub

  13. Private Sub cb輸入2_Click()
  14.   Dim sStr$
  15.   
  16.   sStr = CStr(cbSheet)
  17.   With Sheets(sStr)
  18.       If Application.WorksheetFunction.CountIf(.Range("a:a"), txt編號2) > 0 Then
  19.           MsgBox "編號已存在!", vbCritical, "錯誤"
  20.           Exit Sub
  21.       End If
  22.       With .Range("A65536").End(xlUp)
  23.          
  24.           .Range("A2") = txt編號2
  25.           .Range("B2") = txt姓名1
  26.           .Range("C2") = txt日期1
  27.           iMax(vNo(vSh(sStr))) = iMax(vNo(vSh(sStr))) + 1
  28.           txt編號2.Text = vSh(sStr) & "-" & Right("0000" & iMax(vNo(vSh(sStr))) + 1, 4)
  29.       End With
  30.   End With
  31. End Sub

  33. Private Sub txt日期1_Change()
  34.   Dim sStr$
  35.   
  36.   sStr = IIf(Hour(Now) > 12, "下午", "上午")
  37.   txt日期1 = Format(Now, "yyyy/m/d " & sStr & Format(Now, " h:mm"))
  38. End Sub

  40. Public Sub UserForm_Initialize()
  41.   Dim sStr$
  42.   Dim vA
  43.   
  44.   GetSht
  45.   sStr = ActiveSheet.Name
  46.   With cbSheet
  47.     .Clear
  48.     For Each vA In vSh
  49.       .AddItem vA
  50.       If vA = sStr Then .Value = sStr
  51.     Next
  52.     If .Value = "" Then
  53.       .ListIndex = 0
  54.     End If
  55.   End With
  56.   SetForm
  57. End Sub

  59. Private Sub SetForm()
  60.   Dim sStr$
  61.   
  62.   Application.CommandBars(1).Controls(iBtn).Visible = False
  63.   sStr = CStr(cbSheet)
  64.   Sheets(sStr).Select
  65.   txt編號2.Text = vSh(sStr) & "-" & Right("0000" & iMax(vNo(vSh(sStr))) + 1, 4)
  66.   Label2.Caption = Sheets(sStr).[B1]
  67.   txt日期1 = Format(Now, "yyyy/m/d " & sStr & Format(Now, " h:mm"))
  68. End Sub

  70. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  71.    Application.CommandBars(1).Controls(iBtn).Visible = True
  72. End Sub
複製代碼
ThisWorkBook
  1. Private Sub Workbook_Open()
  2.   SetButton (False)
  3.   GetSht
  4.   SetButton (True)
  5. End Sub

  7. Private Sub SetButton(bSw As Boolean)
  8.   Dim sName$
  9.   Dim bNFind As Boolean
  10.   Dim vC, tcbLdData
  11.   
  12.   sName = "開啟表格"
  13.   If Not bSw Then
  14.     For Each vC In Application.CommandBars(1).Controls
  15.       With vC
  16.         If .Caption = sName Then
  17.           .Visible = False
  18.           iBtn = .Index
  19.         End If
  20.       End With
  21.     Next
  22.   Else
  23.     bNFind = True
  24.     For Each vC In Application.CommandBars(1).Controls
  25.       With vC
  26.         If .Caption = sName Then
  27.           bNFind = False
  28.           .Visible = True
  29.           iBtn = .Index
  30.         End If
  31.       End With
  32.     Next
  33.   
  34.     If bNFind Then
  35.       Set tcbLdData = Application.CommandBars(1).Controls.Add(Type:=msoControlButton)
  36.       With tcbLdData
  37.         .Caption = sName
  38.         .FaceId = 2778
  39.         .OnAction = "ShowForm"
  40.         iBtn = .Index
  41.       End With
  42.     End If
  43.   End If
  44. End Sub

  46. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  47.   Application.CommandBars(1).Controls(iBtn).Delete
  48. End Sub
複製代碼
Module1
  1. Public iMax%(), iBtn%
  2. Public vNo, vSh

  4. Option Explicit

  6. Public Sub ShowForm()

  8. On Error GoTo ErrShowForm
  9.   With ufTar
  10.     If .Visible = False Then .Show
  11.   End With
  12.   
  13. On Error GoTo 0
  14.   Exit Sub

  16. ErrShowForm:

  18.   Select Case Err.Number
  19.   
  20.     Case 424 ' 此處需要物件
  21.       ufTar.Show
  22.       
  23.       
  24.     Case 13 ' 型態不符合
  25.       Set vSh = CreateObject("Scripting.Dictionary")
  26.       Set vNo = CreateObject("Scripting.Dictionary")
  27.       ReDim iMax(0)
  28.       
  29.     Case Else
  30.       On Error GoTo 0
  31.   End Select
  32.   Resume
  33. End Sub

  35. Public Sub GetSht()
  36.   Dim iNum%
  37.   Dim lRow&
  38.   Dim sStr$
  39.   Dim bNFind1 As Boolean, bNFind2 As Boolean
  40.   Dim vA, vB

  42. On Error GoTo ErrGetSht
  43.   
  44.   bNFind2 = False
  45.   For Each vA In Worksheets
  46.     bNFind1 = True
  47.     For Each vB In vSh
  48.       If vB = vA.Name Then
  49.         bNFind1 = False
  50.         Exit For
  51.       End If
  52.     Next
  53.     If bNFind1 Then
  54.       bNFind2 = True
  55.       Exit For
  56.     End If
  57.   Next
  58.   
  59.   If Not bNFind2 Then
  60.     bNFind2 = False
  61.     For Each vA In vSh
  62.       bNFind1 = True
  63.       For Each vB In Worksheets
  64.         If vB.Name = vA Then
  65.           bNFind1 = False
  66.           Exit For
  67.         End If
  68.       Next
  69.       If bNFind1 Then
  70.         bNFind2 = True
  71.         Exit For
  72.       End If
  73.     Next
  74.   End If
  75.   
  76.   If bNFind2 Then
  77.     GoSub SetSel
  78.   End If

  80. On Error GoTo 0
  81.   Exit Sub


  84. SetSel:
  85.   Set vSh = CreateObject("Scripting.Dictionary")
  86.   Set vNo = CreateObject("Scripting.Dictionary")
  87.   ReDim iMax(0)
  88.   For Each vA In Worksheets
  89.     With vA
  90.       If .Name Like "工作表*" Then
  91.         If .[A2] = "" Then .[A2] = "xxx-0001"
  92.         sStr = Left(.[A2], InStrRev(.[A2], "-") - 1)
  93.         vSh(CStr(.Name)) = sStr
  94.         ReDim Preserve iMax(UBound(iMax, 1) + 1)
  95.         iMax(UBound(iMax, 1)) = 0
  96.         vNo(sStr) = UBound(iMax, 1)
  97.   
  98.         lRow = 2
  99.         Do While .Cells(lRow, 1) <> ""
  100.           sStr = .Cells(lRow, 1)
  101.           iNum = Val(Mid(sStr, InStrRev(sStr, "-") + 1))
  102.           If iNum >= iMax(UBound(iMax, 1)) Then iMax(UBound(iMax, 1)) = iNum
  103.           lRow = lRow + 1
  104.         Loop
  105.       End If
  106.     End With
  107.   Next
  108. Return


  111. ErrGetSht:

  113.   Select Case Err.Number
  114.   
  115.     Case 424 ' 此處需要物件
  116.       Set vSh = CreateObject("Scripting.Dictionary")
  117.       Set vNo = CreateObject("Scripting.Dictionary")
  118.       ReDim iMax(0)
  119.    
  120.     Case 13 ' 型態不符合
  121.       Set vSh = CreateObject("Scripting.Dictionary")
  122.       Set vNo = CreateObject("Scripting.Dictionary")
  123.       ReDim iMax(0)
  124.    
  125.     Case Else
  126.       On Error GoTo 0
  127.   End Select
  128.   Resume
  129. End Sub
複製代碼
TEXT-a.zip (25.55 KB)

TOP

ann.liu

帖子
16 
主題
4 
精華
0 
積分
26 
點名
0  
作業系統
WINDOWN XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
女 
來自
TW 
註冊時間
2011-5-11 
最後登錄
2017-12-17 

論壇贊助勳章
8#
發表於 2014-10-31 11:11 | 只看該作者
GBKEE大大
試後還是不能自動進號
ANN

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2014-10-31 09:54 | 只看該作者
回復 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

ann.liu

帖子
16 
主題
4 
精華
0 
積分
26 
點名
0  
作業系統
WINDOWN XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
女 
來自
TW 
註冊時間
2011-5-11 
最後登錄
2017-12-17 

論壇贊助勳章
6#
發表於 2014-10-31 09:36 | 只看該作者
TEXT-a.rar (27.31 KB) 回復 5# GBKEE

感謝luhpro與GBKEE大大的回覆，二位大大的方法都是可以使用。

另外要請教luhpro大大
1.如果我有4個UserForm 都要自動編號，編號都要自動帶出，
我重新製作另外三個表單，但號碼會亂跳，不知錯誤在那，請大大指教﹖

2.我做了4個按鈕點選需要的表單，不要開始excel就自動跳出視窗，
請問大大要如何編寫呢﹖
3.日期顯示可以加上時間嗎﹖
Me.lbl建立日期 = Format(Application.VLookup(Me.cmb編號, Worksheets("工作表1").[編號], 2, 0) , "yyyy/m/d")
   附檔：
另外要請教GBKEE大大
表單如果要連續輸入好幾筆，是否可以自動進位呢
1.        Private Sub CommandButton2_Click() 'cb輸入後,可繼續 + 1
2.        txt編號 = "AL-" & Format(Application.Max(D.KEYS) + 1, "000")
3.        End Sub
ANN

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2014-10-29 08:51 | 只看該作者
回復 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

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
4#
發表於 2014-10-29 00:27 | 只看該作者
請教各位大大：
是否可以在TextBox顯示A:A最後一個編號再+1
點選CommandButton1後將TextBox顯示的資料COP ...
ann.liu 發表於 2014-10-28 22:44

Module1 :
  1. Public iMax%
複製代碼
ThisWorkBook :
  1. Private Sub Workbook_Open()
  2.   Dim lRow&
  3.   Dim sStr$
  4.   
  5.   iMax = 0
  6.   lRow = 2
  7.   Do While Cells(lRow, 1) <> ""
  8.     sStr = Cells(lRow, 1)
  9.     iNum = Val(Mid(sStr, InStr(1, sStr, "-") + 1))
  10.     If iNum >= iMax Then iMax = iNum
  11.     lRow = lRow + 1
  12.   Loop
  13.   UserForm1.Show
  14. End Sub
複製代碼
UserForm1 :
  1. Private Sub cb輸入_Click()

  3.     With Sheets("工作表1")
  4.         If Application.WorksheetFunction.CountIf(.Range("a:a"), txt編號) > 0 Then
  5.             MsgBox "編號已存在!", vbCritical, "錯誤"
  6.             Exit Sub
  7.         End If
  8.         With .Range("A65536").End(xlUp)
  9.            
  10.             .Range("A2") = txt編號.Text
  11.             iMax = iMax + 1
  12.             txt編號.Text = "AL-" & Right("000" & iMax + 1, 3)
  13.         End With
  14.     End With
  15. End Sub

  17. Private Sub UserForm_Initialize()
  18.   txt編號.Text = "AL-" & Right("000" & iMax + 1, 3)
  19. End Sub
複製代碼
TEXT-a.zip (16.77 KB)

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
3#
發表於 2014-10-28 23:46 | 只看該作者
請問各位大大：
VLOOKUP參照編號產生日期，
但日期的格式與工作表1的格式不同，
請問是否可以改成2014/9 ...
ann.liu 發表於 2014-10-28 23:28

用 Format 函數就可以解決 :
...
Me.lbl建立日期 = Format(Application.VLookup(Me.cmb編號, Worksheets("工作表1").[編號], 2, 0) , "yyyy/m/d")
...

TOP

ann.liu

帖子
16 
主題
4 
精華
0 
積分
26 
點名
0  
作業系統
WINDOWN XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
女 
來自
TW 
註冊時間
2011-5-11 
最後登錄
2017-12-17 

論壇贊助勳章
2#
發表於 2014-10-28 23:28 | 只看該作者

Label日期顯示 格式問題請教

請問各位大大：
VLOOKUP參照編號產生日期，
但日期的格式與工作表1的格式不同，
請問是否可以改成2014/9/5的格式顯示。

TEXT2.rar (14.07 KB)
ANN

TOP

        靜思自在 : 要用心，不要操心、煩心。
返回列表 上一主題