Как создать цикл с использованием двух динамических переменных?

Question

У меня есть несколько ячеек («позиций»), которые требуют определенных цветов и значений интерьера. Каждая из этих ячеек связана с собственной соответствующей ячейкой на другом рабочем листе.

На данный момент у меня есть около 35 таких позиций, но в будущем у меня может быть 150, поэтому добавление их вручную будет утомительным! Вот код, который у меня есть на данный момент:

Dim FirstSheet As Worksheet
Dim Secondsheet As Worksheet
Dim position1 As Range
Dim position2 As Range
Dim position3 As Range
Dim lnCol As Long

Set FirstSheet As ThisWorkbook.Worksheets("FirstSheet")
Set SecondSheet As ThisWorkbook.Worksheets("SecondSheet")
Set position1 = Firstsheet.Range("G11")
Set position2 = Firstsheet.Range("F11")
Set Position3 = Firstsheet.Range("E11")
lnCol = 'this is a column number which is found earlier in the sub.

position1.Interior.Color = SecondSheet.Cells(8, lnCol).Interior.Color
position2.Interior.Color = SecondSheet.Cells(9, lnCol).Interior.Color
position3.Interior.Color = SecondSheet.Cells(10, lnCol).Interior.Color
position1.Offset(2, 0).Value = SecondSheet.Cells(8, lnCol).Value
position2.Offset(2, 0).Value = SecondSheet.Cells(9, lnCol).Value
position3.Offset(2, 0).Value = SecondSheet.Cells(10, lnCol).Value

В идеале, я бы хотел цикл, который бы использовал два массива, которые меняются одновременно, но я понятия не имею, как заставить его работать! Это пример того, что я хотел бы видеть:

For Each PositionVar In Array(position1, position2, position3)
    PositionVar.Interior.Color = dynamicvariable.Interior.Color
    PositionVar.Offset(2,0).Value = dynamicvariable.Value
Next PositionVar

Любая помощь будет принята с благодарностью!

Answer 1

Вы можете использовать:

Option Explicit

Sub test()

    Dim i As Long, y As Long, LastColumn As Long, Counter As Long, lnCol As Long
    Dim ws1 As Worksheet, ws2 As Worksheet

    Counter = 8
    lnCol = 3 'Change value

    With ThisWorkbook
        'Set the sheet with positions
        Set ws1 = .Worksheets("Sheet1")
        'Set the second sheet
        Set ws2 = .Worksheets("Sheet2")
    End With

    With ws1
        'Find the LastColumn of row 11
        LastColumn = .Cells(11, .Columns.Count).End(xlToLeft).Column

        'Loop from the last column until column 5th
        For i = LastColumn To 5 Step -1

            With .Cells(11, i)
                .Interior.Color = ws2.Cells(Counter, lnCol).Interior.Color
                .Offset(2, 0).Value = ws2.Cells(Counter, lnCol).Value
            End With

            Counter = Counter + 1

        Next i

    End With

End Sub

ПРИМЕЧАНИЕ Ограничение использования последнего столбца заключается в том, что если в строке 11 нет значений, следует использовать переменную вместо последнего столбца, ссылаясь наобщая стоимость столбца, который вы хотите

Answer 2

Удалось найти ответ с помощью массивов и управляющей переменной. Вам просто нужно убедиться, что соответствующие переменные находятся в том же порядке! Надеюсь, что это помогает другим.

Dim PositionArray As Variant
Dim SecondSheetArray As Variant
Dim i As Variant 

PositionArray = Array(position1, position2, position3) 
SecondSheetArray = Array(SecondSheet1, SecondSheet2, SecondSheet3) 

For i = 0 To UBound(PositionArray)
    PositionArray(i).Interior.Color = OverviewArray(i).Interior.Color
    PositionArray(i).Offset(2, 0).Value = OverviewArray(i).Value
Next i

Answer 3

Почему вы не используете две петли, сложенные вместе, чтобы решить эту проблему? Например:

for each rng in Array(Range1, Range2, Range3)
    for each position in rng
       'Do whatever you like with this Range
    next position
next rng