各位大大,小弟不才.想做一個填寫出勤紀錄的VBA.但遇上了麻煩.
現有條件如下
worksheets(4)是我想填入的表格

worksheets(5)是我現有資料

我想做一個填入一個相關資料的VBA.效果如下

如果用EXCEL公式我是做到的.但想試用VBA做.K欄和L欄是我用來做輔助用的.因為我做了一個VBA用來畫儲蓄格的框線.雖然有點笨.也希望各位指點一下有沒有更好的方法,CODE如下

Sub link_Click()

Call reset

Worksheets(4).Range("L10").Activate

Do

If Worksheets(4).Range(ActiveCell, ActiveCell).Value = "" Then
    Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call weekday
    
ElseIf Worksheets(4).Range(ActiveCell, ActiveCell).Value <> 0 Then
    Call redday



End If


Loop Until ActiveCell = "end"
Worksheets(4).Range("C5").Activate
End Sub
Sub weekday()
If Worksheets(4).Range(ActiveCell, ActiveCell).Value = "" Then
Call FEB
ElseIf Worksheets(4).Range(ActiveCell, ActiveCell).Value = 7 Then

    Range(ActiveCell, ActiveCell).Offset(0, -4).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, -3).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, 10).Activate
    ActiveCell.Offset(1, 0).Select
    
ElseIf Worksheets(4).Range(ActiveCell, ActiveCell).Value < 7 Then

     Range(ActiveCell, ActiveCell).Offset(0, -4).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, 8).Activate
    ActiveCell.Offset(1, 0).Select
    End If
End Sub
Sub redday()
If Worksheets(4).Range(ActiveCell, ActiveCell).Value <> 0 Then

    Range(ActiveCell, ActiveCell).Offset(0, -7).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, 10).Activate
    ActiveCell.Offset(1, 0).Select
    End If
    
End Sub
Sub FEB()
If Worksheets(4).Range(ActiveCell, ActiveCell).Value = "" Then
    Range(ActiveCell, ActiveCell).Offset(0, -4).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
     Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
     Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
     Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
     Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
    Range(ActiveCell, ActiveCell).Offset(0, -1).Activate
    Call cross
    
    Range(ActiveCell, ActiveCell).Offset(0, 11).Activate
   
    ActiveCell.Offset(1, 0).Select
End If

End Sub
Sub cross()

 With Selection.Borders(xlDiagonalDown)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlDiagonalUp)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
   
 End With
End Sub
Sub reset()
 Range("A10:G40").Select
   
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    '
    Range("A10:G40").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

我在網絡找到一些資料是做多條件查詢,但改完之後就是不行.希望各位可以給我一些建議.萬分感謝.
經過修改的CODE如下,現在我在試填正常工作天工作的工數

Sub fillinperson()

Dim dic As New Dictionary, arr, i As Integer
arr = Worksheets(5).Range("A1").CurrentRegion

For i = 2 To UBound(arr, 1)
dic.Item(arr(i, 1) & arr(i, 2)) = arr(i, 5)
Next
For i = 10 To 40
Worksheets(4).Range("B" & i).Value = dic.Item(Worksheets(4).Range("A" & i).Value & Worksheets(5).Range("C5").Value)
Next
End Sub