在 VBA 中打乱一组行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/24036655/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Shuffling a Set of Rows in VBA
提问by Dubeddo
I am new with VBA so I am having some problems sorting this out.
我是 VBA 新手，所以我在解决这个问题时遇到了一些问题。
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
1
乙 2
3
After shuffle:
洗牌后：
C 3
A 1
B 2
3
1
乙 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.
编辑：我曾尝试使用 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(...
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.
凌晨 1 点
1 BM
1个CK
2 A M.. 等等。
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.
所以对于第一行，我还必须能够选择以下两行，这是我无法通过 Vlookup 函数满足的。也许行的索引值可用于随机化，但我不知道如何做到这一点。
Thank you very much in advance.
非常感谢您提前。
回答by Dick Kusleika
Assume you have data in A2:B27 with headers in A1:B1. In C1, put "OriginalRow" and in D1 enter "Rand".
假设您在 A2:B27 中有数据，A1:B1 中有标题。在 C1 中输入“OriginalRow”，在 D1 中输入“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.
此代码对 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
