Установка ячейки равной случайному значению, если ячейка не пуста в диапазоне

Question

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

Кто-нибудь знает, как получить это ожидаемое поведение?

Приведенный ниже код показывает, что я пробовал в настоящее время, каждый большой блок прокомментирован, чтобы помочь с пониманием.Блок, в котором мне нужна помощь, заменяет значения в каждом столбце до тех пор, пока следующая ячейка не станет пустой, а затем переместится в следующий столбец.

upperBound = 1798
lowerBound = 2

Randomize

'This loop section populates the data area with a static value in cell 9,3 then 9,4 etc..
For j = 3 To 15
   val = Cells(9, j).Value
   For i = 1 To val
      Cells(12 + i, j).Value = Cells(9, j)
   Next i
Next j

'This loop section uses the cells already populated down each column and replaces that value with the random value from the other range
Dim x As Integer
' Set numrows = number of rows of data.
For j = 3 To 15
  NumRows = Range(Cells(13, j), Cells(13, j).End(xlDown)).Rows.Count
  ' Select cell 13,j.
  Cells(13, j).Select
  ' Establish "For" loop to loop "numrows" number of times.
  For x = 1 To NumRows
       ActiveCell.Value = Worksheets("2017 Role IDs").Cells(Int((upperBound - lowerBound + 1) * Rnd + lowerBound), 2).Value
     ' Selects cell down 1 row from active cell.
     ActiveCell.Offset(1, 0).Select
  Next
Next j

Это данные перед запуском второго блока.Я хочу заменить значения, которые просто соответствуют числу во второй строке, случайным числом в диапазоне:

Это то, что я хотел бывыглядеть так:

Но в настоящее время это выглядит так, потому что случайный селектор принимает пустые значения:

Answer 1

Что-то вроде этого должно работать для вас:

Sub tgr()

    Dim wb As Workbook
    Dim wsNums As Worksheet
    Dim wsDest As Worksheet
    Dim aData As Variant
    Dim vData As Variant
    Dim aNums() As Double
    Dim aResults() As Variant
    Dim lNumCount As Long
    Dim lMaxRows As Long
    Dim lRowCount As Long
    Dim ixNum As Long
    Dim ixResult As Long
    Dim ixCol As Long

    Set wb = ActiveWorkbook
    Set wsNums = wb.Worksheets("2017 Role IDs")
    Set wsDest = wb.ActiveSheet

    With wsNums.Range("B2", wsNums.Cells(wsNums.Rows.Count, "B").End(xlUp))
        If .Row < 2 Then Exit Sub   'No data
        lNumCount = WorksheetFunction.Count(.Cells)
        If lNumCount = 0 Then Exit Sub  'No numbers
        ReDim aNums(1 To lNumCount)
        If .Cells.Count = 1 Then
            ReDim aData(1 To 1, 1 To 1)
            aData(1, 1) = .Value
        Else
            aData = .Value
        End If

        'Load populated numeric cells into the aNums array
        For Each vData In aData
            If Len(vData) > 0 And IsNumeric(vData) Then
                ixNum = ixNum + 1
                aNums(ixNum) = vData
            End If
        Next vData
    End With

    lMaxRows = Application.Max(wsDest.Range("C9:O9"))
    If lMaxRows = 0 Then Exit Sub   'Row count not populated in row 9 for each column
    ReDim aResults(1 To WorksheetFunction.Max(wsDest.Range("C9:O9")), 1 To 13)

    'Populate each column accordingly and pull a random number from aNums
    For ixCol = 1 To UBound(aResults, 2)
        If IsNumeric(wsDest.Cells(9, ixCol + 2).Value) Then
            For ixResult = 1 To CLng(wsDest.Cells(9, ixCol + 2).Value)
                Randomize
                aResults(ixResult, ixCol) = aNums(Int(Rnd() * lNumCount) + 1)
            Next ixResult
        End If
    Next ixCol

    wsDest.Range("C13").Resize(UBound(aResults, 1), UBound(aResults, 2)).Value = aResults

End Sub