Question

我是VBA的新手，所以我在解决这个问题时遇到了一些问题。

我有一组行，我必须记录一个宏来洗牌所有行。也就是说，在运行宏之后，必须没有任何行保持不变。

事实是，这组值不是一列。必须考虑几个列。必须在不改变整行的情况下进行改组，并且必须对所有列进行随机播放。

一个非常简单的例子：随机播放前的值：

A 1

B 2

C 3

洗牌之后：

C 3

A 1

B 2

此外，此代码必须在每次运行时生成随机顺序，因此必须具有灵活性。

编辑：我尝试过使用VLookup，但它变得非常复杂并且无法正常运行。

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(...

这里我尝试在选择第一个值时捕获其他列的值。但问题是必须随机选择第一个值。并且它并不一定意味着我将为第一列选择的值对于I＆lt; ll选择的行不应该是相同的。我的数据接近以下内容：

1 A M

1 B M

1 C K

2 A M ..等等。

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

非常感谢你。

Answer 1

假设您在A2：B27中有数据，标题为A1：B1。在C1中，输入“OriginalRow”并在D1中输入“Rand”。

此代码对Rand列上的行进行排序，直到每一行都在不同的位置。有26行，它很少占用5个循环。即使只有三行，它也很少尝试7次。

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中拖拽一组行

1 个答案: