我想用Excel作为我的扑克牌庄家。 下面是生成20个1到52之间的随机数字(牌)的代码。 前20张扑克牌的输出在A1:A20列。 我想让下一组20张扑克牌在A22:A41中生成,第三列A43:A62,以此类推。 如何修正代码,使其在A列显示1000张手牌,每组手牌之间隔一行? 谢谢您了。
Sub cards()
Range("A:A").Clear
cardstodraw = 20
For x = 1 To cardstodraw
begL:
ActiveSheet.Cells(1, 2) = "=Randbetween(1,52)"
ActiveSheet.Cells(x, 1) = ActiveSheet.Cells(1, 2).Text
cardvalue = ActiveSheet.Cells(x, 1)
y = 1
Count = 0
Do Until ActiveSheet.Cells(y, 1) = ""
If ActiveSheet.Cells(y, 1) = cardvalue Then
Count = Count + 1
End If: y = y + 1: Loop
If Count > 1 Then GoTo begL
Next
Range("B1").Clear
End Sub
你的代码有点令人费解(使用了 GoTo
通常是一个可以改进的迹象)。) 为了得到从1-52的20个大小的样本,使用修改后的 费舍尔-耶茨洗牌:
Option Explicit 'you really should be using this
Function deal(n As Long, k As Long) As Variant
'returns an array of length k
'consisting of k numbers in the range 1 to n
Dim deck As Variant
Dim i As Long, j As Long, temp As Long
ReDim deck(1 To n)
For i = 1 To n
deck(i) = i
Next i
With Application.WorksheetFunction
'do k steps of a Fisher-Yates shuffle on deck
For i = 1 To .Min(k, n - 1)
j = .RandBetween(i, n)
If i < j Then 'swap
temp = deck(i)
deck(i) = deck(j)
deck(j) = temp
End If
Next i
End With
ReDim Preserve deck(1 To k)
deal = deck
End Function
如果你想在A栏有1000手。
Sub ManyHands()
Dim i As Long
With Application.WorksheetFunction
For i = 1 To 1000
Range(Cells(1 + 21 * (i - 1), 1), Cells(21 * i - 1, 1)).Value = .Transpose(deal(52, 20))
Next i
End With
End Sub
在 "编辑 "栏 这是一个修改后的代码版本,一个给多个玩家发牌的代码。
Function deal(n As Long, k As Long, players As Long) As Variant
'returns an array with k rows and players columns
'consisting of k*players numbers in range 1 to n
'if players = 1, then the array is 1-dimensional
'otherwise it is 2-dimensional
Dim deck As Variant
Dim i As Long, j As Long, temp As Long
Dim hands As Variant
ReDim deck(1 To n)
For i = 1 To n
deck(i) = i
Next i
With Application.WorksheetFunction
'do k*players steps of a Fisher-Yates shuffle on deck
For i = 1 To .Min(k * players, n - 1)
j = .RandBetween(i, n)
If i < j Then 'swap
temp = deck(i)
deck(i) = deck(j)
deck(j) = temp
End If
Next i
End With
ReDim Preserve deck(1 To k * players)
If players = 1 Then
deal = deck
Exit Function
Else
ReDim hands(1 To k, 1 To players)
For i = 1 To k
For j = 1 To players
hands(i, j) = deck(players * (i - 1) + j)
Next j
Next i
deal = hands
End If
End Function
可以这样用:
Sub ManyHands()
Dim i As Long
For i = 1 To 1000
Range(Cells(1 + 11 * (i - 1), 1), Cells(11 * i - 1, 2)).Value = deal(52, 10, 2)
Next i
End Sub
试试吧
Sub cards()
Dim cardstodraw As Long, numberofhands As Long, i As Long, j As Long, k As Long
cardstodraw = 20
numberofhands = 50
Range("A:A").Clear
With Application.WorksheetFunction
For j = 0 To numberofhands - 1
For i = 1 To cardstodraw
begL:
Cells(i + k + (j * cardstodraw), 1) = .RandBetween(1, 52)
If .CountIf(Range(Cells(1 + k + (j * cardstodraw), 1), Cells(20 + k + (j * cardstodraw), 1)), Cells(i + k + (j * cardstodraw), 1)) > 1 Then GoTo begL
Next i
k = k + 1
Next j
End With
End Sub