随机数组r

mjgw

Sub test1()
Dim B1arr, B2arr, B3arr, B1Tarr, B2Tarr, B3Tarr, B4arr, B4Tarr, str1 As String, str2 As String, str3 As String, rrr, ius%, sa1, sa2, sa3, sa2a, sa3a
B1arr = Sheets(1).UsedRange
B1Tarr = WorksheetFunction.Transpose(B1arr)
w1 = Change2to1b(B1Tarr)

For i = 1 To 5
w1a = Randomarray1(w1, 3)

ss1 = w1a(1): ss1a = Split(ss1, "|"): ss1aa = Randomarray1(ss1a, 1)
ss2 = w1a(2): ss2a = Split(ss2, "|"): ss2aa = Randomarray1(ss2a, 1)
ss3 = w1a(3): ss3a = Split(ss3, "|"): ss3aa = Randomarray1(ss3a, 1)

Sheets(2).Cells(i, "A") = ss1aa(1)
Sheets(2).Cells(i, "B") = ss2aa(1)
Sheets(2).Cells(i, "C") = ss3aa(1)
Next i
End Sub

'¶tάêyÖμ×aò»Î¬êy×é
Function Change2to1b(arr)
ReDim ar(1 To UBound(arr))
For i = 1 To UBound(arr)
e = ""
    For j = 1 To UBound(arr, 2)
      ttt = Replace(arr(i, j), " ", "")
     If ttt <> "" Then
      e = e & ttt & "|"
     End If
    Next j
      If e <> "" Then
      r = r + 1
      ar(r) = e
     End If
Next i
ReDim Preserve ar(1 To r)
Change2to1b = ar
End Function


Function Randomarray1(arrr, Cnt)
ReDim brr(1 To Cnt)
   For i = 1 To Cnt
    it = WorksheetFunction.RandBetween(1, UBound(arrr))
     brr(i) = arrr(it)
     arrr = VBA.Filter(arrr, arrr(it), False)
   Next i
   Randomarray1 = brr
End Function




当i=1时    w1数目为5个  w1a = Randomarray1(w1, 3) 后，会减少3个，w1数目为2个.
当i=2时   w1数目为2个.   再执行这个 w1a = Randomarray1(w1, 3) 数目不够就报错了。

所以希望的是  w1数目为5个，一直是5个，然后每次随机的到里面的3个。