[發問] 考勤表VBA難題求助

missbb

本人一直學習VBA及爬文, 發現單一VBA問題不大, 但要個功能就墮入困局, 又是考勤表問題, 期望給予協助:
考勤表 20150815.rar (109.15 KB)

下載次數: 5

2015-8-15 17:37

從學習書內抄考用了相信是愚蠢的方法, 求教::Q

Sub match2()
'combine id card no and date for searching


Dim srcrange As Range, fndrange As Range
Dim fstaddress As String, i As Integer
Dim fc As Integer
Dim fr As Integer
Dim fr2 As Integer



Worksheets("attendance report").Activate

fc = 12
fr = 4
fr2 = 3

Set srcrange = Worksheets("data").Range("a4").CurrentRegion.Columns(9)
Set fndrange = srcrange.Find(what:=Range(fr, fc) & Range("v" & fr2).Value)

If Not fndrange Is Nothing Then

fstaddress = fndrange.Address

i = 5

Do
Cells(i, 22).Value = fndrange.Offset(, 0).Value
Cells(i + 1, 22).Value = fndrange.Offset(1, 0).Value
Cells(i + 8, 22).Value = fndrange.Offset(2, 0).Value
Cells(i + 9, 22).Value = fndrange.Offset(3, 0).Value

i = 1 + 1

Loop Until findrange.Address = fstaddress

Else

MsgBox "XX"
End If



End Sub

lpk187

回復 1# missbb

Range(fr, fc)中的fr、fc必需為Address不是用欄號和列號
所以要改成Cells(fr, fc)

missbb

回復 2# lpk187

你好, 我改了但只可出現1個人及1日的資料, 那個LOOP不知如何處理::(

Dim srcrange As Range, fndrange As Range
Dim fstaddress As String, i As Integer
Dim fc As Integer
Dim fr As Integer
Dim fr2 As Integer

Worksheets("attendance report").Activate

fc = 1
fr = 4
fr2 = 3

Set srcrange = Worksheets("data").Range("a4").CurrentRegion.Columns(9)
Set fndrange = srcrange.Find(what:=Cells(fr, fc) & Cells(fr2, 11).Value)

If Not fndrange Is Nothing Then

fstaddress = fndrange.Address

i = 5
Do
Cells(i, 11).Value = fndrange.Offset(, -2).Value
Cells(i + 1, 11).Value = fndrange.Offset(3, -2).Value
Cells(i + 7, 11).Value = fndrange.Offset(2, -2).Value
Cells(i + 8, 11).Value = fndrange.Offset(1, -2).Value
i = 1 + 1
Loop Until fndrange.Address = fstaddress
Else
MsgBox "XX"
End If
End Sub

lpk187

回復 3# missbb


   
Sub match2()
'combine id card no and date for searching


Dim srcrange As Range, fndrange As Range
Dim fstaddress As String, i As Integer
Dim fc As Integer
Dim fr As Integer
Dim fr2 As Integer

Worksheets("attendance report").Activate

fc = 1
fr = 4
fr2 = 3

Set srcrange = Worksheets("data").Range("a4").CurrentRegion.Columns(9)
Set fndrange = srcrange.Find(what:=Cells(fr, fc) & Format(Cells(fr2, 11), "d/m/yyyy"))
If Not fndrange Is Nothing Then

fstaddress = fndrange.Address

i = 5
Do
Cells(i, 11).Value = fndrange.Offset(, -2).Value
Cells(i + 1, 11).Value = fndrange.Offset(3, -2).Value
Cells(i + 7, 11).Value = fndrange.Offset(2, -2).Value
Cells(i + 8, 11).Value = fndrange.Offset(1, -2).Value
i = 1 + 1
Loop Until fndrange.Address = fstaddress
Else
MsgBox "XX"
End If
End Sub

missbb

回復 4# lpk187

你好, 我的解說及要求, 有勞看看! 拜託:L

下載 (44.82 KB)

2015-8-15 20:13

lpk187

回復 5# missbb

我不知道對不對，以下給你參考

1. Sub match2()
   
2. 'combine id card no and date for searching
   
3. Dim srcrange As Range, fndrange As Range
   
4. Dim fstaddress As String, i As Integer
   
5. Dim fc As Integer
   
6. Dim fr As Integer
   
7. Dim fr2 As Integer
   
8. Worksheets("attendance report").Activate
   
9. fc = 1
   
10. fr = 4
    
11. fr2 = 3
    
12. Set srcrange = Worksheets("data").Range("a4").CurrentRegion.Columns(9)
    
13. 
    
14. For Each Rng In [k3:ao3]
    
15.     Set fndrange = srcrange.Find(Cells(fr, fc) & Format(Rng, "d/m/yyyy"))
    
16.     If Not fndrange Is Nothing Then
    
17.         Cells(5, Rng.Column).Value = fndrange.Offset(, -2).Value
    
18.         Cells(6, Rng.Column).Value = fndrange.Offset(3, -2).Value
    
19.         Cells(12, Rng.Column).Value = fndrange.Offset(2, -2).Value
    
20.         Cells(13, Rng.Column).Value = fndrange.Offset(1, -2).Value
    
21.         i = 1 + 1
    
22.     Else
    
23.     MsgBox "XX"
    
24.     End If
    
25. Next
    
26. End Sub

複製代碼

missbb

回復 6# lpk187

很多謝, 是這樣的想法, 但還有2點: (1) 如何做下一個員工呢, 因為共有200多人? (2)如果時間只有3個, 如7月1日, 程式中就多取了7月3日的第一個時間, 要作出限制如圖所示:感激不盡

下載 (143.75 KB)

2015-8-15 22:10

考勤表 20150815 v4.rar (284.58 KB)

下載次數: 3

2015-8-15 22:11

lpk187

回復 7# missbb

(1) 如何做下一個員工呢, 因為共有200多人?
Ans:
這要看你員工編號要從哪裡讀取了，只要知美在哪讀取員工編號，就比較好做了！


考勤表 20150815 v4.rar (113.63 KB)

下載次數: 7

2015-8-15 23:48

還有有時讀出的資料，有5筆這時又該如何呢？
我上傳的檔案，是把第5第放在下班時間，第4筆則不顯示

missbb

回復 8# lpk187
時間找取正確! 第5筆(或最後一筆)視為下班就對了, 其他會留空. 很厲害!
再次感激, 因為員工資料與打咭時間放在不同SHEETS, 請看圖內資料::D

下載 (45.36 KB)

2015-8-16 00:10

lpk187

回復 9# missbb

試試看！
我還是利用ee data資料夾來做，嗯，這樣比較方便！
    考勤表 20150815 v4.rar (117.04 KB)

下載次數: 10

2015-8-16 00:48