Блог

Я пытаюсь присвоить значения 1-мерного массива диапазону ячеек.

Например; мой массив содержит 23 элемента (каждый элемент рандомизирован от 1 до 5), а диапазон моих ячеек — от A1 до I7.
Я хочу случайным образом присвоить каждое значение моего массива этому диапазону ячеек.
Я рандомизирую значения ячеек в своем массиве, но значения моего массива не полностью присваиваются ячейкам.

 Sub define_ore_body()
    Dim lb_grade As Integer, ub_grade As Integer
    Dim ore_body(1 To 23) As Variant
    Dim i As Integer, j As Integer, k As Integer
    Dim a As Object
    Dim b As Range
    
    Application.ScreenUpdating = False
    'my selected range area A1toI7
    Set b = Application.Range("A1:I7")
    Set a = Application.Cells
    
    '******* low and high ore bound ******
    lb_grade = InputBox("Enter lowest ore grade:")
    ub_grade = InputBox("Enter highest ore grade:")
    'The reason why I do it as follows is that if the random lower bound does not start from 1, 
    'the largest random number it generates is 2 more than the value I have entered, so
    If lb_grade > 1 Then
        ub_grade = ub_grade - 2
    End If
    
    '******* Random Array ******
    'array has 23 items
    For i = 1 To 23
        ore_body(i) = Int((ub_grade * Rnd)   lb_grade)
    Next i
    
    '******* filling random cells with my array******
    k = 1
    For Each a In b
        If a.Value = "" And k < 23 Then
            b(Int(7 * Rnd   1), (8 * Rnd   1)) = ore_body(k)
        ElseIf a.Count > 23 And k > 23 Then
        Exit For
        Else
        k = k   1
        End If
    Next a
    
    '******* after filling cell now fill empty cells with Zero******
    For i = 1 To 7
        For j = 1 To 9
            If Cells(i, j) = "" Then
                    Cells(i, j) = 0
            Else
            End If
        Next j
    Next i
    
    '******* Coloring only containing array values******
    For i = 1 To 7
        For j = 1 To 9
            If Cells(i, j) > 0 Then
                Application.Cells(i, j).Interior.ColorIndex = 38
            Else
            End If
        Next j
    Next i
    
End Sub
 

Массив содержит 23 элемента, которые инициализируются Variant/Empty :

 Dim ore_body(1 To 23) As Variant
 

Сделайте так, чтобы 63 элемента, которые инициализируются 0 :

 Dim ore_body(1 To 63) As Long
 

Теперь остальная часть кода будет заполнять первые 23 элемента, потому что это то, что делает цикл:

 For i = 1 To 23
 

Если вы хотите, чтобы цикл выполнялся по всем индексам, рассмотрите возможность использования LBound UBound операторов и для программного извлечения нижней и верхней границ массива соответственно:

 For i = LBound(ore_body) To UBound(ore_body)
 

Обратите внимание, что вы 23 жестко запрограммировали в нескольких местах, что усложнит изменение, если / когда это 23 должно быть 25. Рассмотрите возможность замены каждого его вхождения на Const :

 Const ElementCount As Long = 23
 

Тогда каждый экземпляр 23 может стать ElementCount , а затем, когда он должен стать 25, тогда есть только одно место, для изменения которого требуется какой-либо код.

1. Цикл по массиву.
2. Установите a в случайную ячейку в диапазоне A1: I7.
3. Если ячейка пуста, поместите значение из массива в ячейку, если это не так, повторите шаг 2

 Sub define_ore_body()
Dim lb_grade As Integer, ub_grade As Integer
Dim ore_body(1 To 23) As Variant
Dim i As Long, j As Long, k As Long
Dim a As Range
Dim b As Range

    Application.ScreenUpdating = False

    'my selected range area A1:I7
    Set b = Application.Range("A1:I7")

    ' clear A1:A17
    b.Clear

    '******* low and high ore bound ******
    lb_grade = InputBox("Enter lowest ore grade:")
    ub_grade = InputBox("Enter highest ore grade:")
    'The reason why I do it as follows is that if the random lower bound does not start from 1,
    'the largest random number it generates is 2 more than the value I have entered, so
    If lb_grade > 1 Then
        ub_grade = ub_grade - 2
    End If

    '******* Random Array ******
    'array has 23 items
    For i = 1 To 23
        ore_body(i) = Int((ub_grade * Rnd)   lb_grade)
    Next i

    '******* filling random cells with my array******
    For k = 1 To 23
        Do
            Set a = b.Cells(Int(7 * Rnd)   1, Int(9 * Rnd)   1)
        Loop Until a.Value = ""

        a.Value = ore_body(k)
    Next k

    '******* after filling cell now fill empty cells with Zero******
    For i = 1 To 7
        For j = 1 To 9
            If Cells(i, j) = "" Then
                Cells(i, j) = 0
            Else
            End If
        Next j
    Next i

    '******* Coloring only containing array values******
    For i = 1 To 7
        For j = 1 To 9
            If Cells(i, j) > 0 Then
                Application.Cells(i, j).Interior.ColorIndex = 38
            Else
            End If
        Next j
    Next i

End Sub