У меня есть два диапазона, как показано на этом рисунке.
Я пытаюсь написать макрос VBA, который последовательно выбирает одну ячейку в первом диапазоне («B23 , F27 »), копирует значение выбранной ячейки, затем выбирает случайную ячейку во втором диапазоне (« G23, K27 ») и вставляет значение первой ячейки в случайно выбранную ячейку во втором диапазоне.
Это должно повторяться до тех пор, пока каждая ячейка из первого диапазона не будет скопирована или каждая ячейка во втором диапазоне не будет заполнена новым значением. В этом примере оба результата эквивалентны, поскольку оба диапазона имеют одинаковое количество ячеек (25).
Результат должен быть похож на второе изображение.
Я попытался присвоить массиву первый диапазон, а затем выбрать случайное значение из этого массива и вставить его во второй диапазон. Я также попытался извлечь уникальные значения из первого диапазона, построить с ним словарь, затем выбрать случайную ячейку из второго диапазона и случайное значение из словаря и вставить его. Позже я снова попытался использовать синтаксис VBA «с диапазоном» и «f» или «каждая ячейка в диапазоне», но я не могу просто придумать что-то, что действительно работает. Иногда второй диапазон заполняется различными значениями, но не так, как задумано.
Первый пример: этот просто не работает
Sub fillrange()
Dim empty As Boolean
'This part checks if every cell in the first range as a value in it
For Each Cell In Range("B23", "F27")
If Cell.Value = "" Then
empty = True
End If
Next
'If every cell is filled then
If empty Then
Exit Sub
Else:
With ThisWorkbook.Worksheets("Sheet1)").Range("B23", "F27")
.Cells(Application.WorksheetFunction.RandBetween(1, 25)).Select
.Copy 'the cell select works, but it will copy all range
'This does not work
'For Each Cell In Range("G23", "K27")
'Cells(Application.WorksheetFunction.RandBetween(1, 25)).Select
'.PasteSpecial Paste:=xlPasteValues
'Next
End With
End If
End Sub
Второй пример: он заполняет диапазон, но с неправильными значениями
Sub fillrange2()
Dim empty As Boolean
For Each cell In Range("B23", "F27")
If cell.Value = "" Then
empty = True
'This part checks if every cell in the first range as a value in it
Exit For
End If
Next cell
If empty Then
Exit Sub
Else:
Dim ws As Worksheet
Dim lRow As Long, i As Long
Dim col As New Collection, itm As Variant
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To lRow
On Error Resume Next
col.Add .Range("B23", "F27").Value, CStr(.Range("A" & i).Value)
On Error GoTo 0
Next i
End With
Dim MyAr() As Variant
ReDim MyAr(0 To (col.Count - 1))
For i = 1 To col.Count
MyAr(i - 1) = col.Item(i)
Next
For Each cell In Range("G23", "K27")
cell.Value = Application.WorksheetFunction.RandBetween(LBound(MyAr), UBound(MyAr))
Next
End If
End Sub
Третий пример: как второй пример, он заполняет диапазон, но с неправильными значениями
Sub fillrange3()
Dim MyAr() As Variant
MyAr = Range("B23", "F27")
For Each cell In Range("G23", "K27")
cell.Value = Application.WorksheetFunction.RandBetween(LBound(MyAr), UBound(MyAr))
Next
End Sub