Заполнить строки случайным образом по циклу

Question

У меня есть значения в диапазоне "A1: O1".Каждый столбец имеет уникальное значение в этом диапазоне.Мне нужна помощь в разработке цикла, который будет заполнять 04 раза в каждом столбце одно и то же максимальное значение (значение столбца).Под псевдокодом

Sub FillDownRowsRandomly()
 Dim i As Integer, j As Integer

 'RamdomRow=Total of 04 unique ramdom numbers
 'choosen from 01 to 06 {1,2,3,4,5,6}
 'meaning that in a loop of 6 interations, when fill down
 '2 will be Null or empty
 '
 For i = 1 To 15 'Columns "A" To "O"
     For j = 2 To 7 '
     '
     Cells(RandomRow, i).Value = Cells(1, i).Value
     Next j
 Next i
 End Sub

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

Answer 1

Может быть что-то вроде:

Sub FillDownRowsRandomly()

Dim x As Long, y As Long, z As Long

With Sheet1 'Change accordingly
    For y = 1 To 15
        z = 0
        Do While z < 4
            x = Int((7 - 2 + 1) * Rnd + 2)
            If .Cells(x, y) <> .Cells(1, y) Then
                .Cells(x, y) = .Cells(1, y)
                z = z + 1
            End If
        Loop
    Next y
End With

End Sub

Answer 2

Зацикливание столбцов и случайное размещение значений до четырех в шести строках.

Sub FillDownRowsRandomly()
ActiveSheet.Range("A2:O7").ClearContents
Dim i As Long
For i = 1 To 15 'iterate the columns

    Do Until Application.CountIf(ActiveSheet.Cells(2, i).Resize(6), ActiveSheet.Cells(1, i).Value) >= 4
        Dim j As Long
        j = Application.RandBetween(2, 7)
        ActiveSheet.Cells(j, i).Value = ActiveSheet.Cells(1, i).Value
    Loop
Next i


End Sub