尝试使其适用于多个单元格

Question

我已经编写了这个程序，它根据表1中单元格的值在表2和表3上创建4个单元格的组。

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循环继续到下一个单元格A2，它就会将值输入到下一个2x2单元格组中。因此，如果表1中的A1对应于表2和表3中的范围("A1:B2")，那么表1中的B1将是表2和表3中的("C1:D2")。

有没有人能帮我一下？谢谢。

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