Shuffling a Set of Rows in VBA

问题

I am new with VBA so I am having some problems sorting this out.

I have a set of rows which I have to record a macro to shuffle ALL rows. That is, there must be no rows left unchanged after I run the macro.

And the thing is, this set of values is not a single column. There are several columns which must be taken into account. Shuffling has to be made without changing the entire row, and the shuffle has to occur for all of the columns.

A very simple example: Values before shuffle:

A 1

B 2

C 3

After shuffle:

C 3

A 1

B 2

in addition, this code has to generate random orders every time it runs, hence it has to be flexible.

Edit: I have tried using VLookup, but it became very complex and didn't run properly.

Sub Shuffle()

Dim i as Variant
Dim j as Variant
Dim myTable as Range
Set myTable = Sheets(1).Range("A1:C10")

'after setting everything up I tried getting the entire row and assigning it to variables, in the worksheet I have 3 columns.
For i=1 to myTable.Rows.Count
Col1=Application.WorksheetFunction.Vlookup(...

Here I am trying to capture the value for other columns as I select the first value. But the problem is that the first value must be selected randomly. And it doesn't necessarily mean that the value I will select for the first column shouldn't be the same for the row I'll select. My data is close to the following:

1 A M

1 B M

1 C K

2 A M.. and so on.

So for the first row, I also must be able to select the following two rows, which I could not satisfy via the Vlookup function. Maybe an index value for rows may be used for randomization, but I have no idea how to do that.

Thank you very much in advance.

回答1:

Assume you have data in A2:B27 with headers in A1:B1. In C1, put "OriginalRow" and in D1 enter "Rand".

This code sorts the rows on the Rand column until each row is in a different spot. With 26 rows, it rarely took over 5 loops. Even with only three rows, it rarely took more than 7 tries.

Public Sub Shuffle()

    Dim lCnt As Long
    Dim rRng As Range

    Set rRng = Sheet1.Range("A2:D27")

    'Record which row it starts on
    With rRng.Columns(3)
        .Formula = "=ROW()"
        .Value = .Value
    End With

    Do
        'Add a random value for sorting
        With rRng.Columns(4)
            .Formula = "=RAND()"
            .Value = .Value
        End With

        'Sort on random value
        Sheet1.Sort.SortFields.Clear
        Sheet1.Sort.SortFields.Add rRng.Columns(4), xlSortOnValues, xlAscending
        With Sheet1.Sort
            .SetRange rRng.Offset(-1).Resize(rRng.Rows.Count + 1)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .Apply
        End With

        lCnt = lCnt + 1
    'if any rows are the same as the starting row
    'do it again
    Loop Until ShuffleComplete(rRng.Columns(3)) Or lCnt > 100

    Debug.Print lCnt

End Sub

Public Function ShuffleComplete(rRng As Range) As Boolean

    Dim rCell As Range
    Dim bReturn As Boolean

    bReturn = True

    For Each rCell In rRng.Cells
        If rCell.Value = rCell.Row Then
            bReturn = False
            Exit For
        End If
    Next rCell

    ShuffleComplete = bReturn

End Function

来源：https://stackoverflow.com/questions/24036655/shuffling-a-set-of-rows-in-vba

标签

vba

excel

shuffle