Сравнение массивов и присвоение значений Excel VBA

У меня два календаря, один на 10 машин, второй на 15 водителей. Я хочу назначить водителей на каждый день календаря автомобилей.

Вот изображение календаря автомобилей

А вот и сделан календарь водителей

Вот мой код, который объясняет мою цель, но, конечно, не работает, потому что я не знаком с vba. Я могу понять, как сравнивать значения обоих массивов по столбцу, но не могу присвоить значение из столбца имен драйверов для календарь автомобилей

Private Sub CommandButton1_Click()

Dim cars() As Variant
Dim drivers() As Variant
cars = Range("A1:F10")
drivers = Range("M1:R15")

For Each carDay In cars
   For Eeach driverDay In drivers
      Dim driver As Long
      Set driver = driverDay(1)
         If carDay(2) = driverDay(2) Then
            carDay.Value = driver
            driverDay.Value = "used"
         End If
   Next driverDay
Next carDay


End Sub

excel vba variable-assignment jagged-arrays
person Иван Олександров    schedule 16.05.2020    source источник
comment
Ваши изображения календаря не имеют заголовков... это усложняет понимание того, что на самом деле содержат ваши календари... и также неясно, как вы хотите соединить два календаря друг с другом...   -  person Andras    schedule 17.05.2020
comment
Отправной точкой, кажется, является ваш Календарь автомобилей, в котором, возможно, есть автомобили и их заказы ..? Затем вы пытаетесь назначить водителей автомобилям и скопировать все даты в календарь водителя?   -  person Andras    schedule 17.05.2020
comment
Если ваш код не работает, то если кто-то попытается получить от него объяснение, он сделает неверные выводы, не так ли...? Вам нужно привести несколько примеров, включая цепочку данных, что дается, затем куда они идут, что делать и к чему это должно привести... Затем в конце может выйти какой-то код...   -  person Andras    schedule 17.05.2020
comment
cars = Range("A1:F10") и drivers = Range("M1:R15") должны быть связаны с рабочим листом и, возможно, с рабочей книгой, как минимум cars = ActiveWorkbook.ActiveSheet.Range("A1:F10") и drivers = ActiveWorkbook.ActiveSheet.Range("M1:R15")...   -  person Andras    schedule 17.05.2020

Ответы (1)


arrow_upward
0
arrow_downward

См. Объект коллекции

Option Explicit

Sub CommandButton1_Click()

    Dim coA As New Collection, coI As New Collection, coY As New Collection
    Dim n As Integer, d As Integer, sDriver As String, sCar As String
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    For d = 1 To 5
        For n = 1 To 15
            sDriver = ws.Cells(n, "M")
            Select Case ws.Cells(n, "M").Offset(0, d)
                Case "A": coA.Add sDriver
                Case "I": coI.Add sDriver
                Case "Y": coY.Add sDriver
            End Select
        Next

        For n = 1 To 10
            sCar = ws.Cells(n, "A")
            Select Case ws.Cells(n, "A").Offset(0, d)
                Case "A": sDriver = coA(1): coA.Remove 1
                Case "I": sDriver = coI(1): coI.Remove 1
                Case "Y": sDriver = coY(1): coY.Remove 1
            End Select
            ws.Cells(20 + n, "A").Offset(0, d) = sCar & ":" & sDriver
        Next

        Set coA = Nothing
        Set coI = Nothing
        Set coY = Nothing

    Next

End Sub
person CDP1802    schedule 17.05.2020
comment
Благодарю вас! Это именно то, что мне нужно. Я видел свой путь с зубчатыми массивами, но коллекции тоже работают. - person Иван Олександров; 18.05.2020