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

2019-09-09 09:25发布

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!

3条回答
欢心
2楼-- · 2019-09-09 10:03

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
查看更多
The star\"
3楼-- · 2019-09-09 10:07

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
查看更多
姐就是有狂的资本
4楼-- · 2019-09-09 10:09

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
查看更多
登录 后发表回答