如何在VBA / Excel中显示混洗数组的条目

时间:2015-07-08 01:10:42

标签: arrays excel vba excel-vba shuffle

我一直试图改组11整数数组并将混洗后的数组粘贴到excel中。我发现了一些几乎可以实现我想要的代码,但是它没有返回数组的混洗条目,而是显示了混乱的行号(Col A)和用于排序的随机数(Col B)。

我是VBA的新手并且无法想出返回与Col A中的洗牌行号相对应的数组的条目,如果这有意义的话?我只想看到洗牌的条目,而不是行号或随机数。希望有道理!我正在使用:

Sub Shuffle()

Dim intNumbers(1 To 11) As Integer

'the list of numbers I want to shuffle 
intNumbers(1) = 1
intNumbers(2) = 1
intNumbers(3) = 1
intNumbers(4) = 1
intNumbers(5) = 1
intNumbers(6) = 1
intNumbers(7) = 2
intNumbers(8) = 5
intNumbers(9) = 6
intNumbers(10) = 3
intNumbers(11) = 7

Dim rngNumbers As Range
Dim rngRandom As Range
Dim rngSort As Range
Dim rngTemp As Range



Set rngNumbers = ActiveSheet.Range("A1:A11")
Set rngRandom = ActiveSheet.Range("B1:B11")
Set rngSort = ActiveSheet.Range("A1:B11")



Randomize
 ' store number and random sequence
For Each rngTemp In rngRandom
    rngTemp = Rnd()
    rngTemp.Offset(0, -1) = rngTemp.Row
Next

rngSort.Sort key1:=rngSort.Columns(2)
For Each rngTemp In rngNumbers
    intNumbers(rngTemp.Value) = rngTemp

Next



End Sub

我可以看到这段代码正在做什么,但无法弄清楚如何让它做我想做的事情。还有很多需要学习的东西!

3 个答案:

答案 0 :(得分:0)

以下是使代码有效的一种方法:

Sub Shuffle()

    Dim intNumbers(1 To 11) As Integer
    Dim rngSort As Range
    Dim x As Long

    'the list of numbers I want to shuffle
    intNumbers(1) = 1
    intNumbers(2) = 1
    intNumbers(3) = 1
    intNumbers(4) = 1
    intNumbers(5) = 1
    intNumbers(6) = 1
    intNumbers(7) = 2
    intNumbers(8) = 5
    intNumbers(9) = 6
    intNumbers(10) = 3
    intNumbers(11) = 7

    Set rngSort = ActiveSheet.Range("A1:B11")
    rngSort.Clear

    Randomize
     ' store number and random sequence
    For x = 1 To 11
        rngSort(x, 1) = intNumbers(x)
        rngSort(x, 2) = Rnd()
    Next x

    rngSort.Sort key1:=rngSort.Columns(2)    
    rngSort.Columns(2).Clear

End Sub

答案 1 :(得分:0)

试试这段代码。它将原始行保留在A列中,在列B中排序随机数A> Z,在C列中保留:数组的索引,取决于行号。

Sub Shuffle()

Dim intNumbers(1 To 11) As Integer

'the list of numbers I want to shuffle
intNumbers(1) = 1
intNumbers(2) = 1
intNumbers(3) = 1
intNumbers(4) = 1
intNumbers(5) = 1
intNumbers(6) = 1
intNumbers(7) = 2
intNumbers(8) = 5
intNumbers(9) = 6
intNumbers(10) = 3
intNumbers(11) = 7

Dim rngNumbers As Range
Dim rngRandom As Range
Dim rngSort As Range
Dim rngTemp As Range



Set rngNumbers = ActiveSheet.Range("A1:A11")
Set rngRandom = ActiveSheet.Range("B1:B11")
Set rngSort = ActiveSheet.Range("A1:B11")



Randomize
 ' store number and random sequence
For Each rngTemp In rngRandom
    rngTemp = Rnd()
    rngTemp.Offset(0, -1) = rngTemp.Row
Next

rngSort.Sort key1:=rngSort.Columns(2)
For Each rngTemp In rngNumbers
    rngTemp.Offset(0, 2).Value = intNumbers(rngTemp)

Next



End Sub

答案 2 :(得分:0)

这是两种方法。第一个是一个有点幼稚且不是非常有效的随机播放器,我在模拟“Candyland”游戏时奇怪地使用了它。 sub接受一个传递的数组,并通过随机交换元素对来对其进行混洗(默认值为1000次)。第二个子图说明了使用变量在VBA中保存数组的一些优点,并使用标准技巧将1维数组值发布到1行代码中的列范围内。每次运行它时A1:A11按随机顺序给出11个元素。

Sub Shuffle(Deck As Variant, Optional times As Long = 1000)
    Dim a As Long, b As Long, i As Long, j As Long, k As Long
    Dim temp As Variant
    a = LBound(Deck)
    b = UBound(Deck)
    For i = 1 To times
        j = Application.WorksheetFunction.RandBetween(a, b - 1)
        k = Application.WorksheetFunction.RandBetween(j + 1, b)
        temp = Deck(j)
        Deck(j) = Deck(k)
        Deck(k) = temp
    Next i
End Sub

Sub ShuffleAndPaste()
    Dim v As Variant
    v = Array(1, 1, 1, 1, 1, 1, 2, 5, 6, 3, 7)
    Shuffle v
    Range("A1:A11").Value = Application.WorksheetFunction.Transpose(v)
End Sub

第二种方法更有效,由函数而不是子函数给出。它具有不需要对电子表格做出任何假设的理想特征(例如,列B和C可用),也可以用卡片来考虑 - 非正式地我认为它是“52拾取”洗牌({ {3}}):

Function Shuffle(deck As Variant) As Variant
    Dim cards As New Collection
    Dim shuffledDeck As Variant
    Dim i As Long, j As Long, n As Long
    Dim lb As Long, ub As Long

    Randomize
    lb = LBound(deck)
    ub = UBound(deck)

    ReDim shuffledDeck(lb To ub)
    For i = lb To ub
        cards.Add deck(i)
    Next i
    n = cards.Count

    For i = lb To ub
        j = 1 + Int(n * Rnd())
        shuffledDeck(i) = cards.Item(j)
        cards.Remove j
        n = n - 1
    Next i

    Shuffle = shuffledDeck

End Function

Sub ShuffleAndPaste()
    Dim v As Variant
    v = Array(1, 1, 1, 1, 1, 1, 2, 5, 6, 3, 7)
    v = Shuffle(v) 'since now shuffle is a function
    Range("A1:A11").Value = Application.WorksheetFunction.Transpose(v)
End Sub