Question

所以我有一个包含多个列和行的excel文件。目前它看起来像这样：

  | A  | B  | C  | D  
---------------------
1 | 1a | 1b | 1c | 1d 
---------------------
2 | 2a | 2b | 2c | 2d 
---------------------
3 | 3a | 3b | 3c | 3d
----------------------

我如何随机使用VBA使其成为：

  | A  | B  | C  | D  
---------------------
1 | 3a | 3b | 3c | 3d 
---------------------
2 | 1a | 1b | 1c | 1d 
---------------------
3 | 2a | 2b | 2c | 2d
----------------------

Answer 1

这个问题确实有很多可能的答案。这可能是最蹩脚的一个，但它确实很有效：

添加其他列;
然后将随机值放在此列中;
按此栏排序 - 这正是您想要的！
删除附加列，这样技巧就不可见了！
瞧！

只是为了让你知道这应该是什么样的：

Option Explicit

Public Sub Randomize()

    Dim lCounter    As Long

    Application.ScreenUpdating = False
    Columns("A:A").Insert Shift:=xlToRight

    For lCounter = 1 To 5
        Cells(lCounter, 1) = Rnd()
    Next lCounter

    With ActiveSheet.Sort
        .SortFields.Add Key:=Range("A1:A5")
        .SetRange Range("A1:E5")
        .Apply
    End With

    Columns("A:A").Delete
    Application.ScreenUpdating = False

End Sub

它可以处理像这样的数据：

您可以通过删除幻数并改进范围来进一步更新代码。

Answer 2

这是我的解决方案：

首先，我创建了一个函数来生成a和b之间的随机数而没有重复的值：

jlqmoreno@gmail.com

Julio Jesus Luna Moreno

Option Base 1
Public Function u(a As Variant, b As Variant) As Variant
 Application.Volatile
 Dim k%, p As Double, flag As Boolean, x() As Variant
    k = 1
  flag = False
  ReDim x(1)
   x(1) = Application.RandBetween(a, b)
  Do Until k = b - a + 1

   Do While flag = False
   Randomize
    p = Application.RandBetween(a, b)
     'Debug.Assert p = 2
    resultado = Application.Match(p, x, False)
     If IsError(resultado) Then
      k = k + 1
      ReDim Preserve x(k)
      x(k) = p
       flag = True
      Else
       flag = False
      End If
   Loop
   flag = False
  Loop
  u = x
End Function

这是必须的，因为我需要一个功能来创建没有重复的随机索引（这是粗略的部分）然后我使用我应用的here

逻辑使用了这个函数

使用此功能：

Public Function RNDORDER(rango As Range) As Variant
 Dim z() As Variant, n%, m%, i%, j%, y() As Variant, k%
  n = rango.Rows.count
  m = rango.Columns.count
  k = 1
   ReDim x(n, m)
   ReDim y(n)
    y = u(1, n)
   For i = 1 To n
     For j = 1 To m
     x(i, j) = rango(y(i), j)
     Next j
 Next i

   RNDORDER = x

只需将此函数作为数组函数运行。

谢谢！

Answer 3

我会像下面这样说：

Sub ShuffleRows()
    Dim vals As Variant, val As Variant
    Dim iRow As Long

    With Range("A1").CurrentRegion '<--| reference your contiguous range 
        vals = .Value '<--| store its content in an array
        For Each val In GetRandomNumbers(.Rows.count) '<--| loop through referenced range shuffled rows indexes
            iRow = iRow + 1 '<--| update current row to write in counter
            .Rows(iRow).Value = Application.Index(vals, val, 0) '<--| write in current rows to write the random row from corresponding shuffled rows indexes
        Next
    End With
End Sub

Function GetRandomNumbers(ByVal n As Long) As Variant
    Dim i As Long, rndN As Long, tempN As Long

    ReDim randomNumbers(1 To n) As Long '<--| resize the array to the number of rows
    For i = 1 To n '<--| fill it with integer numbers from 1 to nr of rows
        randomNumbers(i) = i
    Next

    'shuffle array
    Do While i > 2
        i = i - 1
        Randomize
        rndN = Int(i * Rnd + 1)
        tempN = randomNumbers(i)
        randomNumbers(i) = randomNumbers(rndN)
        randomNumbers(rndN) = tempN
    Loop
    GetRandomNumbers = randomNumbers
End Function

VBA中的随机行

3 个答案: