Question

我正在寻找一种VBA代码算法，可以彻底，快速地对阵列进行洗牌。（为1M手牌运行卡片模拟）

（详细说明：我正在制作一张104张牌（2张牌）的鞋子，玩一只二十一点牌，记录结果，然后用另一只手重建和重新组装鞋子。重复这个过程1M次。）

我现在使用的代码（在线发现）正在返回偏差结果的非随机shuffle。我发现的所有其他随机播放代码只是其中的一种变体。

'shuffle
For N = 0 To N = UBound(shoe)
shoe(N) = N
Next

Randomize

For N = 0 To N = UBound(shoe)
X = Int(Rnd() * UBound(shoe)) + 1
J = shoe(N) = shoe(X)
shoe(N) = shoe(X)
shoe(X) = J
Next

如果我把另一个用于循环并再次运行1000次以上我得到了我正在寻找的结果，但它对于1M手动模拟运行得太慢了。

任何人都知道任何解决方案吗？

编辑：

还尝试了这段代码。洗牌看起来不错，但速度很慢。

For i = 1 To 2000
c1 = Int(101 * Rnd)
c2 = Int(101 * Rnd)
temp = shoe(c1)
shoe(c1) = shoe(c2)
shoe(c2) = temp
Next i

Answer 1

它与您的算法无关，内置的EXCEL RNG不适合运行大量模拟。另外，对于Blackjack来说，1M的鞋子SIM卡也没有意义，Excel真的不适合这些SIM卡。你最好使用C ++

Answer 2

也许你可以在每场比赛中随机化最初的牌组牌？下面使用.NET的Collection Array。希望它能够自行解释。

当您从下面的代码中获取 i＆＃39; 卡时，您需要oCardsAvailable.Remove i。我不知道它是多么随机，但我认为它已经足够了。运行TestShuffle列出一些随机存取的卡片。

' Spade: 1 | Heart: 2 | Club: 3 | Diamond: 4
' Index: 1 2 3 4 5 6 7 8 9 10 11 12 13
' Card:  A 2 3 4 5 6 7 8 9 10 J  Q  K
' CardID: abcc
' a = Deck Number
' b = Symbol
' cc = Card (A 2 3 4 5 6 7 8 9 10 J Q K)
Option Explicit

Dim oCardsAvailable As Object

Sub StartGame(ByVal lCol As Long)
    On Error Resume Next
    Dim iDecks As Long, iCardsPerDeck As Long, MaxCount As Long
    Dim iDeck As Integer, iCard As Integer, iSymbol As Integer, CardID As Long
    Dim lRow As Long
    ' Initialize
    If Not oCardsAvailable Is Nothing Then
        oCardsAvailable.Clear
        Set oCardsAvailable = Nothing
    End If
    Set oCardsAvailable = CreateObject("System.Collections.ArrayList")
    oCardsAvailable.capacity = iCardsPerDeck * iDecks
    iCardsPerDeck = Range("B1").Value
    iDecks = Range("B2").Value
    MaxCount = iCardsPerDeck * iDecks
    lRow = 9
    ActiveSheet.Cells(lRow - 1, lCol).Value = lCol
    ' Randomly add the cards to oCardsAvailable
    Do
        iDeck = WorksheetFunction.RandBetween(1, iDecks) * 1000 ' Shift to 4th digit
        iSymbol = WorksheetFunction.RandBetween(1, 4) * 100 ' Shift to 3rd digit
        iCard = WorksheetFunction.RandBetween(1, 13) ' Card is last 2 digits
        CardID = iDeck + iSymbol + iCard
        If Not oCardsAvailable.contains(CardID) Then
            oCardsAvailable.Add CardID
            ActiveSheet.Cells(lRow, lCol).Value = CardID
            lRow = lRow + 1
        End If
    Loop Until oCardsAvailable.Count = MaxCount        
End Sub

Sub TestShuffle()
    Dim i As Long
    For i = 1 To 10
        StartGame i
    Next
End Sub

样品输出：

Answer 3

要使用Excel在VBA中快速运行算法，请尝试此操作..

在您的VBA代码的开头添加以下行：

Application.ScreenUpdating = False
在您的VBA代码末尾添加以下行：

Application.ScreenUpdating = True

这将带来显着的速度！

VBA寻找快速彻底的阵列混洗算法

3 个答案: