Question

这是我第一次在论坛上发布文章，因此，如果我不遵守规程并对我有点耐心，请原谅我。

在编码方面，我完全是自学成才，过去一直设法从其他人的帖子中找到答案。这个当前的问题使我很烦恼，因为我只是对VBA不够了解，无法看到解决方案。现在的代码会吐出一个 “运行时错误'1004'：应用程序定义或对象定义的错误” 我也尝试研究此错误，并找到了关于该主题的许多答案，但不确定如何将其应用于我的代码。我相当确定我需要在其中添加一个“ With”，但是在我对代码的了解过多之前，我需要一些专业的帮助。

我的代码的目的是使Sheet2（当前工作人员列表）中日历上的名称与工作人员在Sheet1中请求休假的名称列表的匹配。在有匹配项的地方，我想检查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

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

1 个答案: