Попытка сделать эту работу для нескольких ячеек

Question

Я сделал эту программу, которая создает группы из 4 ячеек на листах 2 и 3 в зависимости от значения ячейки на листе 1.

Sub Two_of_Two()

Dim Two_by_Two(1 To 6) As Range

Dim Diag1 As Range

Dim Diag2 As Range

Dim Horiz1 As Range

Dim Horiz2 As Range

Dim Vert1 As Range

Dim Vert2 As Range

Dim Share1 As Range

Dim Share2 As Range

Dim TopLeft As Range

Dim BottomRight As Range

Dim Black As Integer

Dim White As Integer

 Black = 255

 White = 0

Set Diag1 = Sheet1.Range("E17:F18")

Set Diag2 = Sheet1.Range("H17:I18")

Set Horiz1 = Sheet1.Range("E21:F22")

Set Horiz2 = Sheet1.Range("H21:I22")

Set Vert1 = Sheet1.Range("E24:F25")

Set Vert2 = Sheet1.Range("H24:I25")

Set Two_by_Two(1) = Diag1

Set Two_by_Two(2) = Diag2

Set Two_by_Two(3) = Horiz1

Set Two_by_Two(4) = Horiz2

Set Two_by_Two(5) = Vert1

Set Two_by_Two(6) = Vert2

Dim Cell As Range

Dim Subpixel As Range

For Each Cell In Sheet1.Range("A1")

    Set Share1 = Sheet2.Range("A1:B2")

    Set Share2 = Sheet3.Range("A1:B2")

    Share1.Value = Two_by_Two(Int((6 - 1 + 1) * Rnd + 1)).Value

    If Cell.Value >= 127.5 Then

    Share2.Value = Share1.Value

    ElseIf 127.5 > Cell.Value Then

        For Each Subpixel In Share1

            If Subpixel.Value = Black Then

            Sheet3.Cells(Subpixel.Row, Subpixel.Column) = White

            ElseIf Subpixel.Value = White Then

            Sheet3.Cells(Subpixel.Row, Subpixel.Column) = Black

            End If

        Next Subpixel

    End If

Next Cell

End Sub

Я хочу сделать так, чтобы это работало для нескольких клетки. Скажем, когда for l oop переходит к следующей ячейке A2, он вводит значения в следующую группу ячеек 2x2. Таким образом, если A1 на листе 1 соответствует диапазону («A1: B2») на листах 2 и 3, то B1 на листе 1 будет («C1: D2») на листах 2 и 3.

Can кто-нибудь, пожалуйста, помогите мне с этим? Спасибо.

Answer 1

Я немного очистил код и зациклил массив Two_by_Two.

Sub Two_of_Two()
    Dim Two_by_Two(1 To 6) As Range
    Dim Diag1 As Range: Set Diag1 = Sheet1.Range("E17:F18")
    Dim Diag2 As Range: Set Diag2 = Sheet1.Range("H17:I18")
    Dim Horiz1 As Range: Set Horiz1 = Sheet1.Range("E21:F22")
    Dim Horiz2 As Range: Set Horiz2 = Sheet1.Range("H21:I22")
    Dim Vert1 As Range: Set Vert1 = Sheet1.Range("E24:F25")
    Dim Vert2 As Range: Set Vert2 = Sheet1.Range("H24:I25")
    Dim Share1 As Range: Set Share1 = Sheet2.Range("A1:B2")
    Dim Share2 As Range: Set Share2 = Sheet3.Range("A1:B2")
    Dim TopLeft, BottomRight, Cell, Subpixel As Range
    Dim Black, White, rndval As Integer
    Dim i As Long

    Black = 255
    White = 0

    Set Two_by_Two(1) = Diag1
    Set Two_by_Two(2) = Diag2
    Set Two_by_Two(3) = Horiz1
    Set Two_by_Two(4) = Horiz2
    Set Two_by_Two(5) = Vert1
    Set Two_by_Two(6) = Vert2

    rndval = Int(6 * Rnd + 1)
    Share1.Value = Two_by_Two(rndval).Value

    If Sheet1.Cells(1, 1) >= 127.5 Then
        Share2.Value = Share1.Value
    Else
        Share2.Value = Sheet1.Cells(1, 1)
    End If

    For Each Subpixel In Share1
        If Subpixel.Value = Black Then
            Sheet3.Cells(Subpixel.Row, Subpixel.Column) = White
        ElseIf Subpixel.Value = White Then
            Sheet3.Cells(Subpixel.Row, Subpixel.Column) = Black
        End If
    Next Subpixel
End Sub