EXCEL中如何用VBA让数据根据条件，进行随机排序。具体问题看下图，先谢过！！！

Question

如题所述

Answer 1

Sub dd()
Dim i As Integer, dic As Object, ii As Integer, xl As Integer, iii As Integer, arr
Set dic = CreateObject("scripting.dictionary")
ActiveSheet.Range("b1:b16").ClearContents
i = 1
Do While i <= ActiveSheet.Range("A65536").End(xlUp).Row
    dic(ActiveSheet.Range("A" & i).Value) = ActiveSheet.Range("A" & i).Value
    i = i + 1
Loop
ii = 1
arr = dic.items
xl = Application.WorksheetFunction.RandBetween(0, dic.Count - 1)
Do While ii <= ActiveSheet.Range("A65536").End(xlUp).Row
    i = ActiveSheet.Range("B65536").End(xlUp).Row
    Do While i >= Int((ii - 1) / 4) * 4 + 1
        If Left(ActiveSheet.Range("B" & i).Value, 1) = Left(arr(xl), 1) Then
           iii = iii + 1
           i = i - 1
           If iii = 2 Then
              xl = Application.WorksheetFunction.RandBetween(0, dic.Count - 1)
              i = ActiveSheet.Range("B65536").End(xlUp).Row
            End If
         End If
         i = i - 1
    Loop
    If ActiveSheet.Range("B65536").End(xlUp).Value <> "" Then
         ActiveSheet.Range("B65536").End(xlUp).Offset(1) = arr(xl)
    Else
         ActiveSheet.Range("b1") = arr(xl)
    End If
    dic.Remove arr(xl)
    arr = dic.items
    If dic.Count > 0 Then
        xl = Application.WorksheetFunction.RandBetween(0, dic.Count - 1)
    End If
ii = ii + 1
Loop
End Sub

Answer 2

Sub 乱序()
 Dim i&
 For i = 1 To 16
  Cells(i, 2) = Cells(i, 1)
  Cells(i, 3) = Rnd()
  Cells(i, 4) = Left(Cells(i, 1), 1)
 Next i
 Range("B1:D16").Sort Key1:=Range("C1")
 For i = 1 To 16
  Cells(i, 3) = Application.WorksheetFunction.CountIf(Range(Cells(1, 4), Cells(i, 4)), Cells(i, 4))
 Next i
 Range("B1:D16").Sort Key1:=Range("C1")
 Range("C1:D16").ClearContents
End Sub

借用了C、D两列进行排序和计算。

追问

老师谢谢您的回答，我试了试你的程序，发现是每四个单元格里第一个数都不重复，我想要的是每四个单元格里第一个数重复不超过两个（两个允许），并且A列的数据很庞大，希望老师能再帮我解决下。谢谢！！！

本回答被网友采纳