Board logo

標題: [發問] 考勤表VBA難題求助 [打印本頁]
作者: missbb    時間: 2015-8-15 17:39     標題: 考勤表VBA難題求助

本人一直學習VBA及爬文, 發現單一VBA問題不大, 但要個功能就墮入困局, 又是考勤表問題, 期望給予協助:
[attach]21719[/attach]

從學習書內抄考用了相信是愚蠢的方法, 求教::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    時間: 2015-8-15 18:17

回復 1# missbb

Range(fr, fc)中的fr、fc必需為Address不是用欄號和列號
所以要改成Cells(fr, fc)
作者: missbb    時間: 2015-8-15 18:58

回復 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    時間: 2015-8-15 19:56

本帖最後由 lpk187 於 2015-8-15 20:02 編輯

回復 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    時間: 2015-8-15 20:14

回復 4# lpk187

你好, 我的解說及要求, 有勞看看! 拜託:L
[attach]21720[/attach]
作者: lpk187    時間: 2015-8-15 21:13

本帖最後由 lpk187 於 2015-8-15 21:15 編輯

回復 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)

  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    時間: 2015-8-15 22:11

本帖最後由 missbb 於 2015-8-15 22:13 編輯

回復 6# lpk187

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

本帖最後由 lpk187 於 2015-8-15 23:55 編輯

回復 7# missbb

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


[attach]21724[/attach]

還有有時讀出的資料，有5筆這時又該如何呢？
我上傳的檔案，是把第5第放在下班時間，第4筆則不顯示
作者: missbb    時間: 2015-8-16 00:11

本帖最後由 missbb 於 2015-8-16 00:13 編輯

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

[attach]21725[/attach]
作者: lpk187    時間: 2015-8-16 00:48

本帖最後由 lpk187 於 2015-8-16 00:50 編輯

回復 9# missbb

試試看！
我還是利用ee data資料夾來做，嗯，這樣比較方便！
    [attach]21726[/attach]
作者: missbb    時間: 2015-8-16 08:23

回復 10# lpk187


    太感謝了, 我會學習當中運用, 有勞大司:'( 為我解決了頭痛多月的問題!
作者: lpk187    時間: 2015-8-16 12:11

回復 11# missbb

我發現，可能你當初寫這檔案時曾產生溢位而導致檔案變很大，來到1.7M
已經幫你處理好了(不過畫面有點不像原來的樣子)，另外新增加一些功能”清除資料“ 及 ”自動填寫日期“以及程式解說，以利你明瞭程式的動作
   
[attach]21728[/attach]
作者: missbb    時間: 2015-8-16 12:19

回復 12# lpk187

是呀, 用函數令FILE運作很慢才用VBA, 感謝細心的增值:'(
作者: GBKEE    時間: 2015-8-16 17:05

回復 13# missbb
字典物件,也可試試看.
  1. Option Explicit
  2. Sub Ex()
  3.     Dim xDATE As Range, i, Rng As Range
  4.     Dim D As Object, K, X As Long, Ar As Variant
  5.     Set xDATE = Sheets("Attendance Report").[J3]  '輸入報表首日之前1日日期 的儲存格
  6.     With Sheets("data")  '資料工作表
  7.         Set Rng = .[D4] '資料開使的儲存格
  8.         X = 0
  9.         Do While Rng <> ""
  10.             Set D = CreateObject("SCRIPTING.DICTIONARY")  '設立變數 :字典物件
  11.             i = 1
  12.             Do While Rng.Offset(i - 1) = Rng  'Employee  上下列相同
  13.                 With Rng.Offset(i - 1)
  14.                     If D.EXISTS(.Range("C1").Value) Then    '如果在 Dictionary 物件中指定的關鍵字存在，傳回 True，
  15.                         D(.Range("C1").Value) = D(.Range("C1").Value) & "," & .Range("D1").Text
  16.                     Else
  17.                         D(.Range("C1").Value) = .Range("D1").Text
  18.                         '.Range("C1").Value 為日期值
  19.                     End If
  20.                  End With
  21.                 i = i + 1
  22.             Loop
  23.             For Each K In D.KEYS  'Keys 方法 傳回一個陣列，該陣列包含一個 Dictionary 物件中的全部既存的的關鍵字。
  24.                 Ar = Split(D(K), ",") 'Keys的內容
  25.                 With xDATE.Offset(, K - xDATE)  'k 為日期值
  26.                     .Parent.Cells(.Row + X + 1, "a") = Rng.Range("b1").Value
  27.                     .Parent.Cells(.Row + X + 1, "d").Resize(20) = Rng
  28.                     If UBound(Ar) = 1 Then
  29.                         .Cells(X + 3) = Ar(0)
  30.                         .Cells(X + 4) = Ar(1)
  31.                     ElseIf UBound(Ar) = 2 Then
  32.                         .Cells(X + 3) = Ar(0)
  33.                         .Cells(X + 4) = Ar(2)
  34.                         .Cells(X + 10) = Ar(1)
  35.                     ElseIf UBound(Ar) = 3 Then
  36.                         .Cells(X + 3) = Ar(0)
  37.                         .Cells(X + 4) = Ar(3)
  38.                         .Cells(X + 10) = Ar(1)
  39.                         .Cells(X + 11) = Ar(2)
  40.                     ElseIf UBound(Ar) = 4 Then
  41.                         .Cells(X + 3) = Ar(0)
  42.                         .Cells(X + 4) = Ar(4)
  43.                         .Cells(X + 10) = Ar(1)
  44.                         .Cells(X + 11) = Ar(2)
  45.                     End If
  46.                 End With
  47.             Next
  48.             X = X + 20
  49.             Set Rng = Rng.Offset(i)
  50.         Loop
  51.     End With
  52. End Sub
複製代碼
作者: missbb    時間: 2015-8-17 22:02

回復 14# GBKEE
想請教將("A4:AP23") COPY 等如員工人數的次數, 但出錯, 是甚麼原因?
  1. [code]Sub COPY_FORMAT()

  3. Dim i As Integer

  5.     Worksheets("attendance report").Activate
  6.    
  7.     QQQQ = Worksheets("ee data").Cells(Rows.Count, "b").End(xlUp).Row
  8.    
  9.     ActiveSheet.Range("A4:AP23").Select
  10.    
  11.     Selection.Copy
  12.    
  13. For i = 1 To QQQQ
  14.    
  15.     ActiveSheet.Range("A" & 1 + i * 20).Select
  16.     ActiveSheet.Paste
  17.   
  18. Next i
  19. End Sub

  21.         


  24.    
複製代碼
[/code]
作者: lpk187    時間: 2015-8-18 10:28

回復 15# missbb

ActiveSheet.Range("A4:AP23").Select
   
    Selection.Copy次<<這裡裡是選擇上面範圍A4:AP23製範圍的複製
但下面的紅色部份卻把上面的選擇更換掉了，所以它只能貼一次，第二次就會出錯了！
For i = 1 To QQQQ
     ActiveSheet.Range("A" & 1 + i * 20).Select
    ActiveSheet.Paste
  Next i
要複製貼上，只要一句就可解決，如下範例：
  1. Sub COPY_FORMAT()
  2. Dim i As Integer
  3.     Worksheets("attendance report").Activate
  4.     QQQQ = Worksheets("ee data").Cells(Rows.Count, "b").End(xlUp).Row
  5. For i = 1 To QQQQ
  6.     ActiveSheet.Range("A4:AP23").Copy Range("A" & 1 + i * 20)
  7. Next i
  8. End Sub
複製代碼
作者: missbb    時間: 2015-8-18 20:59

回復 16# lpk187
多謝指導.
作者: missbb    時間: 2015-8-19 08:37

回復 14# GBKEE

想問為何可以取得姓名呢?因為我在EE DATA及EE內都找不到對應的欄?

           .Parent.Cells(.Row + X + 1, "d").Resize(20) = Rng

另可否從EE DATA一版內將員工編號及部門都放在ATTENDANCE內並顯示20列呢?

有勞賜教!
作者: GBKEE    時間: 2015-8-20 14:22

回復 18# missbb

你附檔的ee data 員工只有2位,可多舉一些.看看
作者: missbb    時間: 2015-8-20 22:08

回復 16# lpk187


        感謝賜教!
作者: missbb    時間: 2015-8-20 22:09

回復 19# GBKEE


我改動了設計, 暫不 用更改了,     感謝賜教!



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)