[發問] 請教新增表單編號問題

afu9240

版大 各位vba高手:

    想請教在表單 按--新增後---表單號碼是否可產生成單號"009", 附上圖片及檔案,,,,

下載 (96.75 KB)

2017-12-13 11:10

維修紀錄DB.zip (28.42 KB)

下載次數: 5

2017-12-13 11:14

求協助!!謝謝

GBKEE

回復 1# afu9240

1. TextBox6.Value = Format(Worksheets("叫修明細").Cells(x, 1) + 1, "000")

複製代碼

afu9240

回復 2# GBKEE

G大 版主  您好  小妹可以再請教一個問題

附件是一個訓練履歷表,為何我用名字mark查詢後,listbox1會出現資料,但在clear後,再輸入mark查詢卻無法出現資料,輸入別得名字也一樣, 是否可解惑!!感恩謝謝

     

下載 (57.51 KB)

2017-12-14 10:17

資料檔.zip (36.5 KB)

下載次數: 11

2017-12-14 10:26

GBKEE

1. Private Sub CommandButton4_Click() 'clear
   
2.     TextBox11.Text = ""
   
3.     TextBox10.Text = ""
   
4.     TextBox1.Text = ""
   
5.     Image1.Picture = LoadPicture
   
6.     With ListBox1
   
7.     'If Selection.Count > 7 Then
   
8.   '  .List = Selection.Value
   
9.   '  Else
   
10.     .Clear
    
11.    ' .AddItem Selection
    
12.    ' End If
    
13.    ' .ColumnCount = Selection.Columns.Count
    
14.     End With
    
15.    
    
16. End Sub

複製代碼

回復 4# afu9240

afu9240

回復 5# GBKEE

G大  您好

    小妹卡住了,關鍵字搜尋要如何帶出到"工作表2"(只要跟這字有關係的都要帶出),真的很抱歉想 資料20171218.zip (43.57 KB)

下載次數: 7

2017-12-18 15:49

跟您請益!!!!

Hsieh

1. Private Sub CommandButton2_Click()
   
2. Dim A As Range, Rng As Range
   
3. If TextBox1.Text = "" Then
   
4.     MsgBox "請輸入正確的值"
   
5. Else
   
6. Application.ScreenUpdating = False
   
7. Worksheets("工作表2").Range("A:G").Clear
   
8. With Worksheets("工作表1")
   
9. Set A = .Cells.Find(TextBox1, Lookat:=xlPart)
   
10. If Not A Is Nothing Then
    
11.   first = A.Address
    
12. Do
    
13. If Rng Is Nothing Then
    
14.    Set Rng = .Cells(A.Row, 1).MergeArea
    
15.    Else
    
16.    Set Rng = Union(Rng, .Cells(A.Row, 1).MergeArea)
    
17. End If
    
18. Set A = .Cells.FindNext(A)
    
19. Loop While Not A Is Nothing And A.Address <> first
    
20. Rng.EntireRow.Copy Sheets("工作表2").[A1]
    
21. Else
    
22. MsgBox "無符合資料"
    
23. End If
    
24. End With
    
25. End If
    
26. Application.ScreenUpdating = True
    
27. End Sub

複製代碼

回復 7# afu9240

afu9240

回復 8# Hsieh

感謝版大,,,長知識 有關日期設定計算.zip (10.87 KB)

下載次數: 9

2018-1-2 15:10

請教一下附件, 如何用vba寫死函數公式, 爬文跟在論壇內找了找都沒有相關文章,是否可協助解惑!小妹感激

GBKEE

回復 9# afu9240

是這樣嗎?

1. Sub old() '年齡自動代入
   
2.     Dim x1, x2, i As Integer
   
3.     Cells(1, 5) = Now()
   
4.     'x1 = YearFrac(Now(), 0) '這裡錯誤
   
5.     'x1 = Application.WorksheetFunction.YearFrac(Now(), 0)
   
6.     X = 2
   
7.     Do
   
8.         Cells(X, "C") = "=AGE(RC[-1])"  'RC[-1] R1C1的格式參照法
   
9.         X = X + 1
   
10.     Loop Until Cells(X, "B") = ""
    
11. End Sub
    
12. '***'Module1(一般模組)的程式碼
    
13. '**自訂函數
    
14. Function AGE(D1)  
    
15.     AGE = "#NA"
    
16.     Application.Volatile (False)
    
17.     If IsDate(D1) And D1 > 0 Then AGE = DateDiff("YYYY", D1, Date)
    
18. End Function

複製代碼

afu9240

回復 8# GBKEE

感謝G大回復..G大真的太厲害了
想請問G大是否可以計算到小數點兩位數  因為現在好像都是取整數

GBKEE

回復 9# afu9240

1. Function AGE(D1 As Range)         'Module1(一般模組)
   
2.     AGE = "#NA"
   
3.     Application.Volatile (False)
   
4.     If IsDate(D1) And D1 > 0 Then
   
5.         AGE = DateDiff("m", D1, Date)
   
6.         AGE = Round(Int(AGE / 12), 0) & "." & AGE - (Round(Int(AGE / 12), 0) * 12)  ' 剩餘月份的小數點
   
7.         'AGE = Round((AGE / 12), 2)   '10進位的小數點
   
8.    End If
   
9. End Function

複製代碼