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

Question

这是我第一次在论坛上发帖，所以如果我在协议方面出现失误，请原谅我，对我有点耐心。

在涉及编码方面，我完全是自学成才，并且过去总是设法从其他人的帖子中找到我的答案。这个当前的问题让我很烦恼，因为我对 VBA 的了解还不够，无法看到解决方案。现在的代码吐出一个 “运行时错误‘1004’： 应用程序定义或对象定义的错误" 我也尝试研究过这个错误，并找到了很多关于这个主题的答案，但我不确定如何将它们应用到我的代码中。我很确定我需要在其中添加一个“With”，但在我把代码弄得更乱之前，我需要一些专业的帮助。

我的代码背后的目的是将Sheet2（当前员工列表）中日历上的姓名与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

Answer 1

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

非常感谢所有提供帮助的人，并特别感谢 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