在VBA中改组一组行 [英] Shuffling a Set of Rows in VBA

问题描述

我是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

洗牌后:

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.

我已经尝试使用VLookup，但是它变得非常复杂并且无法正常运行.

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 ..以此类推.

2 A M.. and so on.

因此，对于第一行，我还必须能够选择以下两行，这是我无法通过Vlookup函数满足的.也许行的索引值可以用于随机化，但是我不知道该怎么做.

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.

非常感谢您.

推荐答案

假定您在A2:B27中有数据，而标头在A1:B1中.在C1中，输入"OriginalRow"，在D1中，输入"Rand".

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

此代码对Rand列上的行进行排序，直到每一行位于不同的位置.有26行，它很少接管5个循环.即使只有三行，也很少需要超过7次尝试.

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

这篇关于在VBA中改组一组行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！