Question

我正在生成＆＃34;随机＆＃34; （没有重复）使用以下内容的问题列表：

Sub randomCollection()
    Dim Names As New Collection
    Dim lastRow As Long, i As Long, j As Long, lin As Long
    Dim wk As Worksheet

    Set wk = Sheets("Sheet1")

    With wk
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    For i = 2 To lastRow
        Names.Add wk.Cells(i, 1).Value, CStr(wk.Cells(i, 1).Value)
    Next i

    lin = 1
    For i = lastRow - 1 To 1 Step -1
        j = Application.WorksheetFunction.RandBetween(1, i)
        lin = lin + 1
        Range("B" & lin) = Names(j)
        Names.Remove j
    Next i

End Sub

我一直坚持如何在B列中提取数据，并使用A列中的相应数据生成数据。

例如，A1和B1需要在＆＃34;随机＆＃34;列表，A2，B2等等。

Answer 1

如果我正确理解您的任务，您希望获取A列中的任何内容并将其放在B列的随机位置，不包括标题行。如果是这种情况，请尝试：

Sub randomCollection()
Dim wrk As Worksheet, source As Long, dest As Long, lastRow As Long, i As Long, rowCount As Long

Set wrk = ActiveWorkbook.ActiveSheet
lastRow = wrk.Rows.Count
lastRow = wrk.Range("A1:A" & Trim(Str(lastRow))).End(xlDown).Row

'First, clear out the destination range
wrk.Range("B2:B" + Trim(Str(lastRow))).Clear

source = 2
Do Until source > lastRow
    dest = Application.WorksheetFunction.RandBetween(1, lastRow - source + 1)
    'Find the blank row corresponding to it
    rowCount = 1
    For i = 2 To lastRow
        If dest = rowCount And wrk.Cells(i, 2) = "" Then
            wrk.Cells(i, 2) = wrk.Cells(source, 1)
            Exit For
        End If
        If wrk.Cells(i, 2) = "" Then '2 is column B
            rowCount = rowCount + 1
        End If
    Next
    source = source + 1
Loop
End Sub

这将查找B列中的第一个随机空格，以便将每个单元格放在A列中。

VBA Excel＆＃34;随机＆＃34;两列发生器

1 个答案: