字典对象与其他字典一起使用时不会删除
任何人都可以解释为什么当我运行两个词典他们不工作？
我的儿子做了一些家庭作业，涉及build立一个洗牌卡组。 我给了他两种方法：第一种是随机构build甲板，第二种是先构build一个甲板，然后随机从第一层甲板上select卡牌，并从中构build第二层甲板。
所以我使用了一个快速的下一个循环来构build从1-52开始的起始套牌，然后从一个新的空字典循环开始，直到新的字典包含全部52张牌。 我通过随机从原来的牌组中挑选一张牌然后将其添加到新的牌组然后将其从原来的牌组中移除。
不过，我一直在原来的甲板上看到超过20张牌，并在新的甲板上重复。
如果我使用集合作为原始甲板和字典作为洗牌甲板它每次都工作！
那么有什么想法？ 在试图使用两本词典的时候，我已经有过几次了。
这两个想法的代码。 RetCard函数只是计算卡的名字。
Public Sub CardBuild1() Dim dDeck As Dictionary Dim dShuffled As Dictionary Dim lCard As Long, lCards As Long Dim lPick As Long, lVal As Long, lIndex As Long Dim sCard As String Dim vItems As Variant Set dDeck = New Dictionary For lCard = 1 To 52 dDeck.Add lCard, lCard Next lCard Set dShuffled = New Dictionary lIndex = 1 Do Until dShuffled.Count = 52 lCards = dDeck.Count lPick = Int((lCards) * Rnd()) + 1 lVal = dDeck(lPick) sCard = RetCard(lVal) dShuffled.Add lIndex, sCard lIndex = lIndex + 1 dDeck.Remove lPick Loop vItems = Application.Transpose(dShuffled.Items) Cells(1, 1).Resize(UBound(vItems, 1), 1) = vItems End Sub Public Sub CardBuild2() Dim cDeck As Collection Dim dShuffled As Dictionary Dim lPick As Long Set cDeck = New Collection For lPick = 1 To 52 cDeck.Add lPick Next lPick Set dShuffled = New Dictionary Do Until dShuffled.Count = 52 lPick = Int((cDeck.Count) * Rnd()) + 1 dShuffled(dShuffled.Count) = RetCard(cDeck(lPick)) cDeck.Remove lPick Loop Cells(1, 1).Resize(52, 1) = Application.Transpose(dShuffled.Items) End Sub Private Function RetCard(lIndex As Long) As String Dim lSuit As Long, lCard As Long Dim sSuit As String lSuit = ((lIndex - 1) \ 13) + 1 lCard = ((lIndex - 1) Mod 13) + 1 sSuit = Choose(lSuit, "Diamonds", "Hearts", "Clubs", "Spades") RetCard = Switch(lCard = 1, "Ace", lCard > 1 And lCard < 11, lCard, lCard = 11, "Jack", lCard = 12, "Queen", lCard = 13, "King") & " of " & sSuit End Function 问题很简单。 每当你想从剩下的牌组中select一个随机牌时，你正在使用lPick = Int((cDeck.Count) * Rnd()) + 1select一个从1到remainingDeck.Count ，然后你想告诉VBA数（从甲板的顶端）n项物品下降，从剩下的甲板上挑选这张随机牌。 这个你希望用下面这行代码实现：
lVal = dDeck(lPick)
但是这不是代码的意思。 相反，你要告诉VBA从原来的（52张牌）套牌中拿到lPick牌。 如果找不到该卡（因为它已被删除），则添加一个空卡。
下面的插图可能会更容易理解。 首先，我们在甲板上有以下卡片：
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
但是当我从甲板（这也是面值8的卡）中移除第8张牌时，我会得到这个：
1 2 3 4 5 6 7 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
如果lPick = Int((cDeck.Count) * Rnd()) + 1然后（随机）碰巧再次是8，那么面值为8的卡片（ 不是第8张卡片）丢失，不能被添加到洗牌平台也不能从旧的甲板上删除。
所以，如果你想告诉VBA，而不是你想从剩下的甲板（这将在上面的例子中的数字9），select第8张卡，那么你必须调整你的代码如下：
Public Sub CardBuild1() Dim dDeck As Dictionary Dim dShuffled As Dictionary Dim lCard As Long, lCards As Long Dim lPick As Long, lVal As Long, lIndex As Long Dim sCard As String Dim vItems As Variant Set dDeck = New Dictionary For lCard = 1 To 52 dDeck.Add lCard, lCard Next lCard Set dShuffled = New Dictionary lIndex = 1 Do Until dShuffled.Count = 52 lCards = dDeck.Count lPick = Int((lCards) * Rnd()) 'by default 0-based and thus no longer +1 here lVal = dDeck.Items(lPick) 'taking the nth card from the top sCard = RetCard(lVal) dShuffled.Add lIndex, sCard lIndex = lIndex + 1 dDeck.Remove (dDeck.Items(lPick)) Loop vItems = Application.Transpose(dShuffled.Items) Cells(1, 1).Resize(UBound(vItems, 1), 1) = vItems End Sub
在第一个子选项中是卡片的值：你应该检查卡片是否仍然在卡片中。 在第二个子lpick中是值的位置（索引）（你没有重复），这就解释了两个子索引之间的区别。
Public Sub CardBuild1() Dim dDeck As Dictionary Dim dShuffled As Dictionary Dim lCard As Long, lCards As Long Dim lPick As Long, lVal As Long, lIndex As Long Dim sCard As String Dim vItems As Variant Set dDeck = New Dictionary For lCard = 1 To 52 dDeck(dDeck.Count) = lCard Next lCard Set dShuffled = New Dictionary lIndex = 1 Do Until dShuffled.Count = 52 lCards = dDeck.Count lPick = Int((lCards) * Rnd()) lVal = dDeck.Items(lPick) Debug.Print lPick & vbTab & lVal vItems = dDeck.Items sCard = RetCard(lVal) dShuffled.Add lIndex, sCard lIndex = lIndex + 1 dDeck.Remove dDeck.Keys(lPick) If dDeck.Count >= lCards Then Stop Loop vItems = Application.Transpose(dShuffled.Items) Cells(1, 1).Resize(UBound(vItems, 1), 1).Clear Cells(1, 1).Resize(UBound(vItems, 1), 1) = vItems End Sub
实际上可以用很less的代码完成，如下所示：
Public Sub CardBuild1() Dim dShuffled As Dictionary Set dShuffled = New Dictionary With dShuffled '<--| reference your new dicctionary Do Until .Count = 52 .Item(Int(52 * Rnd())) = 1 '<--| this will add new item to referenced dictionary if the key (the random number between 1 and 52) is not already there Loop Cells(1, 1).Resize(.Count).Value = Application.Transpose(.Keys) '<--| write directly 'Keys' array into wanted range End With End Sub
然后你可以使用上面的代码的核心来使一个Function返回一个混洗甲板作为一个Dictionary对象：
Function GetShuffledDeck() As Dictionary Dim tempDict As Dictionary Set tempDict = New Dictionary With tempDict Do Until .Count = 52 .Item(Int(52 * Rnd())) = 1 Loop End With Set GetShuffledDeck = tempDict End Function
你可以在你的主代码中使用如下代码：
Sub main() Dim dShuffled As Dictionary Set dShuffled = GetShuffledDeck '<--| use your 'Function' to return a shuffled deck as a dictionary object With dShuffled Cells(1, 1).Resize(.Count).Value = Application.Transpose(.Keys) End With End Sub
一个（也许）最后一步可能是处理卡的dynamic数量：
Function GetDynamicShuffledDeck(Optional nCards As Long) As Dictionary Dim tempDict As Dictionary If nCards <= 0 Then nCards = 52 '<--| if calling sub passed an invalid numbre of cards or no numbre at all then assume 52 cards Set tempDict = New Dictionary With tempDict Do Until .Count = nCards .Item(Int(nCards * Rnd())) = 1 Loop End With Set GetDynamicShuffledDeck = tempDict End Function
这将被你的主要分支调用如下：
Sub main() Dim dShuffled As Dictionary Set dShuffled = GetDynamicShuffledDeck 40 '<--| a 40 cards deck will be returned Set dShuffled = GetDynamicShuffledDeck '<--| no 'nCards' argument passed -> a 52 cards deck will be returned With dShuffled Cells(1, 1).Resize(.Count).Value = Application.Transpose(.Keys) End With End Sub
切线，但如果你想让你的儿子接触洗牌的方法，你也可以向他展示Fisher-Yates shuffle：
Sub FisherYates(deck As Variant) 'assumes that deck is a 1-based array Dim i As Long, j As Long, n As Long Dim temp As Variant n = UBound(deck) For i = n To 2 Step -1 j = Application.WorksheetFunction.RandBetween(1, i - 1) temp = deck(i) deck(i) = deck(j) deck(j) = temp Next i End Sub
testing像：
Sub test() Dim d As Variant Dim i As Long ReDim d(1 To 52) For i = 1 To 52 d(i) = i Next i FisherYates d Debug.Print Join(d, ",") End Sub
典型的输出：
52,25,4,29,24,1,40,50,10,27,7,35,37,15,39,47,41,23,5,19,45,13,51,17,9,32,11,49,26,21,20,36,34,43,28,2,38,44,31,12,18,8,30,33,42,48,46,3,22,14,6,16