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

afu9240

版大 各位vba高手:

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

下載 (96.75 KB)

2017-12-13 11:10

維修紀錄DB.zip (28.42 KB)

下載次數: 6

2017-12-13 11:14

求協助!!謝謝

GBKEE

回復 16# afu9240

1. Function AGE(D1 As Date)     'Module1(一般模組)
   
2.         Application.Volatile (False)
   
3.         If IsDate(D1) And D1 > 0 Then
   
4.             AGE = DateDiff("m", D1, Date)
   
5.             'AGE = Round(Int(AGE / 12), 0) & "." & AGE - (Round(Int(AGE / 12), 0) * 12)  ' 小數點為剩餘月份
   
6.             '***此AGE的程式碼中**  & "." & ** 傳回文字不能計算,用VAL()函數將文字轉為數字,可計算
   
7.             AGE = Val(Round(Int(AGE / 12), 0) & "." & AGE - (Round(Int(AGE / 12), 0) * 12))  ' 小數點為剩餘月份
   
8.             
   
9.             'AGE = Round((AGE / 12), 2)   '小數點為10進位  '***此AGE傳回數字,可計算
   
10.             
    
11.        End If
    
12. End Function

複製代碼

1. Private Sub CommandButton1_Click()
   
2.     With Worksheets("人員年資分析表")
   
3.         If .AutoFilterMode Then .UsedRange.AutoFilter
   
4.     End With
   
5.     End
   
6. End Sub
   
7. 'Private Sub CommandButton4_Click() '*****
   
8. Private Sub ComboBox4_Change()  '可改用Change不須再按查詢
   
9.     Dim Rng As Range, AGE_Average As Double
   
10.     'If ComboBox4.ListIndex = -1 Then MsgBox "請輸入正確的值": Exit Sub
    
11.     If ComboBox4.ListIndex = -1 Then Exit Sub        '.ListIndex = -1 不在清單的內容
    
12.     Set Rng = Worksheets("人員年資分析表").Range("A2")
    
13.     If Rng.Parent.AutoFilterMode Then Rng.AutoFilter   '取消自動篩選
    
14.     Set Rng = Range(Rng, Rng.End(xlToRight).End(xlDown))
    
15.     Rng.AutoFilter 1, ComboBox4.Value
    
16.     Set Rng = Range(Rng.Cells(2, 1), Rng.End(xlToRight).End(xlDown)).SpecialCells(xlCellTypeVisible)
    
17.     AGE_Average = Round(Application.WorksheetFunction.Average(Rng.Columns("G")), 2)
    
18.     MsgBox ComboBox4 & " 部門" & vbLf & "平均年齡 " & AGE_Average
    
19.    
    
20.     With Worksheets("工作表1")
    
21.         .Cells.Clear
    
22.         Rng.Copy .[a1]
    
23.         With .Range("g1", .Range("g1").End(xlDown).Address)
    
24.             .Cells(.Count + 1) = "=Average(" & .Cells.Address & ")"
    
25.            .Cells(.Count + 1).NumberFormatLocal = "0.00_)"
    
26.         End With
    
27.     End With
    
28. End Sub

複製代碼

afu9240

回復 14# GBKEE


    G大 抱歉  想跟您請教
  
   要如何查詢到資料到部門人員資料後,直接計算出部門平均年齡呢???求協助 謝謝

   能在工作表1黃色實線儲存格顯示嗎??? 20180105.zip (45.5 KB)

下載次數: 7

2018-1-5 13:47

afu9240

回復 14# GBKEE


    感謝G大鼓勵,我會努力,>>>>>:'(

GBKEE

回復 13# afu9240
給的程式碼請多了解才會為己用

1. '** Val(文字) >  轉換數字****是因為funtion傳回文字 ,SUM()無法加總,而修改的
   
2.             AGE = Val(Round(Int(AGE / 12), 0) & "." & AGE - (Round(Int(AGE / 12), 0) * 12))  ' 剩餘月份的小數點
   
3. 
   
4.             '**10進位的小數點***平均年齡較為準確  *****************
   
5.             AGE = Round((AGE / 12), 2)   '10進位的小數點    'funtion傳回數字 ,SUM()可以加總不必修改
   
6.             '******************************************

複製代碼

ˋ此程式碼有註解,請再了解看看 ,二選一使用

afu9240

1.     '** Val(文字) >  轉換數字******************
   
2.                 AGE = Val(Round(Int(AGE / 12), 0) & "." & AGE - (Round(Int(AGE / 12), 0) * 12))  ' 剩餘月份的小數點
   
3.                
   
4.                 '**10進位的小數點***平均年齡較為準確  *****************
   
5.                 AGE = Round((AGE / 12), 2)   '10進位的小數點
   
6.                 '*******************************************

複製代碼

回復 12# GBKEE

請教G大 這段 有關日期設定計算年齡2 (2).zip (17.83 KB)

下載次數: 2

2018-1-4 10:11

放進去後,原本計算的年齡會變不正確,是哪一個地方有出現問題呢!!!再請G大協助 謝謝

GBKEE

回復 11# afu9240

1. '** Val(文字) >  轉換數字******************
   
2.             AGE = Val(Round(Int(AGE / 12), 0) & "." & AGE - (Round(Int(AGE / 12), 0) * 12))  ' 剩餘月份的小數點
   
3.             
   
4.             '**10進位的小數點***平均年齡較為準確  *****************
   
5.             AGE = Round((AGE / 12), 2)   '10進位的小數點
   
6.             '*******************************************

複製代碼

1. Sub 平均年齡()
   
2.     Dim aa As Range
   
3.     Cells(1, 8) = Now()
   
4.     'Times = Cells(65536, x + 1).End(xlUp).Row
   
5.     Set aa = Range("d2:d" & [d2].End(xlDown).Row) '所有加總範圍
   
6.    
   
7.     Sheets("工作表1").Cells(9, 9) = Application.WorksheetFunction.Sum(aa) / aa.Count
   
8. End Sub

複製代碼

afu9240

回復 10# GBKEE


    G大真的是我的偶像,,感謝 有關日期設定計算年齡2.zip (17.26 KB)

下載次數: 2

2018-1-3 16:50

　G大　小妹還有一個小問題,附件用您給我的funtion為何帶不出全廠平均年齡～～～

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

複製代碼

afu9240

回復 8# GBKEE

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