员工休假日历上使用的2D For Loop



这是我第一次在论坛上发帖,所以如果我在协议上出错,请原谅我,并对我有点耐心。

在编码方面,我完全自学成才,过去总是能从其他人的帖子中找到答案。这个当前的问题让我很烦恼,因为我对VBA的了解不够,看不到解决方案。现在的代码吐出一个"运行时错误"1004":应用程序定义或对象定义错误"我也尝试过研究这个错误,发现了很多关于这个主题的答案,但不确定如何将它们应用到我的代码中。我很确定我需要在其中添加一个"With",但在我处理代码太多之前,我希望得到一些专业的帮助。

我的代码背后的目的是将Sheet2(当前员工列表(中日历上的姓名与Sheet1中员工请求休假的不断增加的姓名列表相匹配。如果匹配,我想检查Sheet2上包含日历日期的行,该行是否>=休假开始日期AND<=休假结束日期。然后突出显示这是真的单元格。然后,它需要继续对照Sheet1上的名称列表检查Sheet2上的同一行,以查找其他匹配项并执行相同的操作。

Sub Highlight_Calendar()
Dim lRow1 As Long
lRow1 = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row
Dim lRow2 As Long
lRow2 = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Row
Dim lCol2 As Long
lCol2 = Worksheets("Sheet2").Cells(lRow2, Worksheets("Sheet2").Columns.Count).End(xlToLeft).Column
Dim ArrS2Names() As Variant
ArrS2Names = Sheet2.Range("A3", Worksheets("Sheet2").Cells(lRow2, 1))
Dim ArrS1Names() As Variant
ArrS1Names = Sheet1.Range("A3", Worksheets("Sheet1").Cells(lRow1, 1))
Dim calendarArr() As Variant
calendarArr = Sheet2.Range("B3", Worksheets("Sheet2").Cells(lRow2, lCol2))
Dim firstArr() As Variant
firstArr = Sheet1.Range("C3:C" & lRow1)
Dim lastArr() As Variant
lastArr = Sheet1.Range("D3:D" & lRow1)
Dim R1 As Long
Dim R2 As Long
Dim C2 As Long
For R2 = LBound(ArrS2Names, 1) To UBound(ArrS2Names, 1)
For R1 = LBound(ArrS1Names, 1) To UBound(ArrS1Names, 1)
For C2 = LBound(calendarArr, 2) To UBound(calendarArr, 2)
If ArrS2Names(R2, 1) = ArrS1Names(R1, 1) Then
Debug.Print (ArrS2Names(R2, 1))
If calendarArr(R2, C2) >= firstArr(R1, 1) And calendarArr(R2, C2) <= lastArr(R1, 1) Then
Sheet2.Cells(R2, C2).Interior.Color = RGB(0, 255, 0)
Debug.Print (Sheet2.Cells(R2, C2))
End If
End If
Next C2
Next R1
Next R2
End Sub

哇!!我终于找到了我需要的答案,虽然它在功能上相当简单,但我不知道该问什么问题,所以完成它是一项相当艰巨的任务。对于以后的任何人,希望我的代码能帮助回答一些问题。

非常感谢所有提供帮助的人,特别感谢Chris Neilson给了我指导和明确的答案。你可能永远不知道你的评论"多研究Range的工作原理"实际上有多大帮助。我没有意识到我对射程的了解是多么的少。不幸的是,我没有保存我发布的第一个代码的副本,所以由于编辑,问题中的代码与最终结果相当接近。我还不确定如何投票支持讨论,但我会对此进行调查,并投票支持那些提供帮助的人。

Sub Highlight_Calendar()
Dim lRow1 As Long
lRow1 = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row
Dim lRow2 As Long
lRow2 = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Row
Dim lCol2 As Long
lCol2 = Worksheets("Sheet2").Cells(lRow2, Worksheets("Sheet2").Columns.Count).End(xlToLeft).Column
Dim ArrS2Names() As Variant
ArrS2Names = Sheet2.Range("A3", Worksheets("Sheet2").Cells(lRow2, 1))
Dim ArrS1Names() As Variant
ArrS1Names = Sheet1.Range("A3", Worksheets("Sheet1").Cells(lRow1, 1))
Dim calendarArr() As Variant
calendarArr = Sheet2.Range("B3", Worksheets("Sheet2").Cells(lRow2, lCol2))
Dim firstArr() As Variant
firstArr = Sheet1.Range("C3:C" & lRow1)
Dim lastArr() As Variant
lastArr = Sheet1.Range("D3:D" & lRow1)
Dim R1 As Long
Dim R2 As Long
Dim C2 As Long
For R2 = LBound(ArrS2Names, 1) To UBound(ArrS2Names, 1)
For R1 = LBound(ArrS1Names, 1) To UBound(ArrS1Names, 1)
For C2 = LBound(calendarArr, 2) To UBound(calendarArr, 2)
If ArrS2Names(R2, 1) = ArrS1Names(R1, 1) Then
Debug.Print (ArrS2Names(R2, 1))
If calendarArr(R2, C2) >= firstArr(R1, 1) And calendarArr(R2, C2) <= lastArr(R1, 1) Then
Range("B3", Worksheets("Sheet2").Cells(lRow2, lCol2)).Cells(R2, C2).Interior.Color = RGB(0, 255, 0)
Debug.Print Range("B3", Worksheets("Sheet2").Cells(lRow2, lCol2)).Cells(R2, C2)
End If
End If
Next C2
Next R1
Next R2
End Sub

最新更新