VBA Excel“随机”两列生成器

Question

I'm generating a "random" (with no repeats) list of the questions using the following:

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

I'm stuck on how to pick up data in column B , and generate it with the corresponding data in column A .

For example, A1 and B1 need to stay together on the "random" list, as does A2 , B2 , etc.

Answer 1

If I understand your task correctly, you want to take whatever is in column A and put it in column B in random locations, not including a header row. If this is the case, try this:

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

This looks for the first random blank space in column B to put each cell in column A.