返回列表 上一主題 發帖

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

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
1# 跳轉到 »
發表於 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

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
2#
發表於 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 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
3#
發表於 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

        靜思自在 : 對父母要知恩，感恩、報恩。
返回列表 上一主題