How to show entries of a shuffled array in VBA / Excel

亡梦爱人 提交于 2019-12-13 07:19:44

问题


I've been trying to shuffle an 11-integer array and paste the shuffled array into excel. I've found some code that almost does what I want, but instead of returning the shuffled entries of the array it shows the shuffled row numbers (Col A) and the random numbers used for sorting (Col B).

I'm new to VBA and can't figure out to return the entry of the array that corresponds to the shuffled row number in Col A, if that makes sense? I only want to see the shuffled entries and not the row numbers or random numbers. Hope that makes sense! I'm using:

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

I can see what this code is doing but can't figure out how to get it to do what I'd like. Still got a lot to learn!


回答1:


Try this code. It will leave the original rows in column A, sorted random numbers A>Z in column B, and in column C: the index of your array, dependent on the row number.

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:


Here's one way to make your code work:

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



回答3:


Here are two approaches. The first is a somewhat naïve and not terribly efficient shuffle sub which I first used, oddly enough, when simulating the game of "Candyland". The sub takes a passed array and shuffles it by randomly swapping pairs of elements (for a default of 1000 times). The second sub illustrates some of the advantages of using variants to hold arrays in VBA and uses a standard trick which posts a 1-dimensional array of values into a column rage in 1 line of code. Every time you run it A1:A11 is given thos 11 elements in random order.

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

The second approach is more efficient and is given by a function rather than a sub. It shares the desirable feature of not needing to make any assumptions about the spreadsheet (e.g. columns B and C are available) and can also be thought of in terms of cards -- informally I think of it as the "52 pickup" shuffle ( https://en.wikipedia.org/wiki/52_Pickup ):

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


来源:https://stackoverflow.com/questions/31281934/how-to-show-entries-of-a-shuffled-array-in-vba-excel

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!