Question

我正在处理随机数VBA，下面的代码从sheet2中选择一个名称并复制到表1，我可以重复这些步骤从该列表中选择3个不同的名称。当所有三个名称连续三行但在第5行，第10行和第15行时未能选择3个不同的名称时，此代码的作用非常出色。有人可以帮我挑选三个不同的名字并将它们放在相隔5行的行中吗？（第1行第1名，第5行第2名，第15行第3名）我是VBA新手！

Sub DDQ1()
Application.ScreenUpdating = False
Dim source, destination As Range
Set source = Sheets("sheet2").Range("A60:A81")
Sheets("sheet1").Activate
Set destination = ActiveSheet.Range("B53")
ReDim randoms(1 To source.Rows.Count)
destrow = 0
For i = 1 To destination.Rows.Count
 If destination(i) = "" Then: destrow = i: Exit For
Next i
If destrow = 0 Then: MsgBox "no more room in destination range": Exit Sub
For i = 1 To UBound(randoms): randoms(i) = Rnd(): Next i
ipick = 0: tries = 0
Do While ipick = 0 And tries < UBound(randoms)
tries = tries + 1
minrnd = WorksheetFunction.Min(randoms)
For i = 1 To UBound(randoms)
If randoms(i) = minrnd Then
  picked_before = False
  For j = 1 To destrow - 1
    If source(i) = destination(j) Then: picked_before = True: randoms(i) =        2: Exit For
  Next j
  If Not picked_before Then: ipick = i
  Exit For
End If
Next i
Loop
If ipick = 0 Then: MsgBox "no more unique name possible to pick": Exit Sub
destination(destrow) = source(ipick)
Application.ScreenUpdating = True
End Sub

Answer 1

如果我理解正确，如果你改变了行

For i = 1 To destination.Rows.Count

到

For i = 1 To destination.Rows.Count Step 5

这应该有效。虽然当我尝试它时，我还必须使目标范围大于“B53”。我输入“B53：B99”

在三个不同的行中输出随机数

1 个答案: