2D для цикла используется в календаре отпусков персонала - PullRequest
0 голосов
/ 16 ноября 2018

это первый раз, когда я публикуюсь на форуме, поэтому, пожалуйста, прости меня, если я не соблюдаю протоколы и буду немного терпелив со мной.

Я полностью самоучка, когда дело касается кодирования, и имеюМне всегда удавалось найти ответы на посты других людей в прошлом.Эта текущая проблема меня раздражает, потому что я просто недостаточно разбираюсь в VBA, чтобы увидеть решение.Код в его нынешнем виде выдает «Ошибка времени выполнения« 1004 »: ошибка приложения или объекта». Я также пытался исследовать эту ошибку и нашел много ответов по этой теме, но не уверен, как их применить кмой кодЯ вполне уверен, что мне нужно будет добавить «С», но я хотел бы получить профессиональную помощь, прежде чем я возиться с кодом слишком много.

Цель моего кода состоит в том, чтобы сопоставить имена накалендарь в Sheet2 (список текущих сотрудников) с растущим списком имен, в которых сотрудники запрашивают отпуск в Sheet1 .Там, где есть совпадение, я хочу проверить строку на Листе 2, которая содержит календарные даты, является ли она> = датой начала отпуска И <= датой окончания отпуска.Затем выделите клетки, где это правда.Затем необходимо продолжить проверку той же строки на Листе 2 по списку имен на Листе1, чтобы найти дополнительные совпадения и выполнить те же действия. </p>

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

1 Ответ

0 голосов
/ 16 ноября 2018

Whoop !! Я наконец-то нашел ответы, которые мне нужны для этого, и хотя это довольно просто функционально, я не знал, какие вопросы задавать, так что это было довольно изнурительное задание. Для всех, кто придет после, надеюсь, мой код поможет ответить на некоторые вопросы.

Огромное спасибо всем, кто помог, и особая благодарность Крису Нилсону за то, что он дал мне руководство и ясность, чтобы найти мои собственные ответы. Вы, возможно, никогда не узнаете, насколько полезен ваш комментарий о том, как «провести больше исследований о том, как работает 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...