加班費計算

mmggmm

各位:  
本人想請教有關加班費月結和年結的計算.(執行巨集)
  月結更改年和月就可擷取Sheet"Main"資料. OT.rar (20.15 KB)

下載次數: 36

2012-5-5 11:32

Hsieh

回復 1# mmggmm

1. Private Sub Worksheet_Change(ByVal Target As Range) '月結
   
2. If Intersect(Target, Union([A1], [C1])) Is Nothing Then Exit Sub
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. MyDay = [A1] & [C1]
   
5. With Sheets("Main")
   
6. For Each a In .Range(.[A2], .[A2].End(xlDown))
   
7.    If Format(a, "yyyym") = MyDay Then
   
8.      If IsEmpty(d(a.Offset(, 1).Value)) Then
   
9.         d(a.Offset(, 1).Value) = Array(a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, a.Offset(, 4).Value)
   
10.         Else
    
11.         ar = d(a.Offset(, 1).Value)
    
12.         ar(2) = ar(2) + a.Offset(, 3): ar(3) = ar(3) + a.Offset(, 4)
    
13.         d(a.Offset(, 1).Value) = ar
    
14.         Erase ar
    
15.      End If
    
16.     End If
    
17. Next
    
18. Me.Range("A1").CurrentRegion.Offset(3).ClearContents
    
19. If d.Count > 0 Then Me.[A3].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(d.items))
    
20. End With
    
21. End Sub

複製代碼

1. Private Sub Worksheet_Change(ByVal Target As Range) '年結
   
2. If Intersect(Target, [A1]) Is Nothing Then Exit Sub
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. MyYear = [A1]
   
5. With Sheets("Main")
   
6. For Each a In .Range(.[A2], .[A2].End(xlDown))
   
7.    If Year(a) = MyYear Then
   
8.      If IsEmpty(d(a.Offset(, 1).Value)) Then
   
9.         d(a.Offset(, 1).Value) = Array(a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, a.Offset(, 4).Value)
   
10.         Else
    
11.         ar = d(a.Offset(, 1).Value)
    
12.         ar(2) = ar(2) + a.Offset(, 3): ar(3) = ar(3) + a.Offset(, 4)
    
13.         d(a.Offset(, 1).Value) = ar
    
14.         Erase ar
    
15.      End If
    
16.     End If
    
17. Next
    
18. Me.Range("A1").CurrentRegion.Offset(3).ClearContents
    
19. If d.Count > 0 Then Me.[A3].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(d.items))
    
20. End With
    
21. End Sub

複製代碼

mmggmm

H大大,好了不起,這就是我要的,不過我要慢慢消化,謝謝.

freeffly

回復 2# Hsieh


    好簡潔的方法
   如果是我應該會用
   1.進階篩選的方式找出NO 跟姓名
   2.然後在用函數去加總加班時數跟金額

   速度上可能就比版主的速度再慢一點

mmggmm

H大大:
  程式試用後發現一個問題,例如"月結"擷取資料後,再揀選叧一個月而該月份其實沒有資料可取,但程式並未將所有資料刪除還保留第一筆資料."年結"同有這問題.何解,請幫助解決,謝謝.

Hsieh

回復 5# mmggmm
這行Offset(3)錯誤
改成
Me.Range("A1").CurrentRegion.Offset(2).ClearContents

mmggmm

多謝賜教,多謝.