|
vba解决随机重排的完整代码:
可对任意矩形范围内单元格内的数据内容直接重新排序,
如果该矩形范围内所有单元格都为空,则填入随机序数,即随机填入1-n的正整数。
Sub RectangleDataRandom()
Dim a
Dim s As New Collection, t As New Collection
Randomize
a = Selection
For i = 0 To UBound(a, 1) - 1
For j = 0 To UBound(a, 2) - 1
s.Add a(i + 1, j + 1)
If B = "" Then B = B & a(i + 1, j + 1)
t.Add 1 + j Mod UBound(a, 2) + (i Mod UBound(a, 1)) * UBound(a, 2)
Next
Next
If B = "" Then
For i = 1 To UBound(a, 1)
For j = 1 To UBound(a, 2)
K = Int(Rnd() * t.Count + 1)
a(i, j) = t(K)
t.Remove (K)
Next
Next
Else
For i = 1 To UBound(a, 1)
For j = 1 To UBound(a, 2)
K = Int(Rnd() * s.Count + 1)
a(i, j) = s(K)
s.Remove (K)
Next
Next
End If
Selection = a
'[a1].Resize(UBound(a, 1), UBound(a, 2)) = a
End Sub |
|