随机数字自由组合排列？

Question

哪位高手能帮小弟一个忙啊 
就是随机从两组数字中任意各取3个数字组成一组的全排列
这两组的个数是固定的 一组是12个数 另一组是21个数
但是这两组的数是不固定的 可以自由更换的 可以设计一对话框
可以依次输入a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12
b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14,b15,b16,b17,b18,b19,b20,b21,的数字 分别从a组b组中任意取3个数全排列并将结果保存在电脑上
这样的源程序能写吗 ？
 程序要求越高效越好
  谢谢！

Answer 1

能完成,你用2个文本框录入后,用split拆分为数组再做全排列.关于split的用法在本版可搜到许多的:)

Answer 2

Private Sub Command1_Click()
Dim ss1$, ss2$, s1$(), s2$(), ss$, s$
ss1 = "a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12 "
ss2 = "b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14,b15,b16,b17,b18,b19,b20,b21"
s1 = Split(ss1, ","): s2 = Split(ss2, ",")
For i = 1 To 3
    Do
    s = s1(Int(Rnd * (UBound(s1) + 1)))
    Loop While 0 < InStr(ss, s)
    ss = ss & s & ","
    Do
    s = s2(Int(Rnd * (UBound(s2) + 1)))
    Loop While 0 < InStr(ss, s)
    ss = ss & s & ","
Next i
MsgBox ss
End Sub

Answer 3

输出文本，路径自己修改。
Private Sub Command1_Click()
Dim ss1$, ss2$, s1$(), s2$(), ss$, s$
ss1 = "a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12 "
ss2 = "b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14,b15,b16,b17,b18,b19,b20,b21"
s1 = Split(ss1, ","): s2 = Split(ss2, ",")
For i = 1 To 3
    Do
    s = s1(Int(Rnd * (UBound(s1) + 1)))
    Loop While 0 < InStr(ss, s)
    ss = ss & s & ","
    Do
    s = s2(Int(Rnd * (UBound(s2) + 1)))
    Loop While 0 < InStr(ss, s)
    ss = ss & s & ","
Next i
Open App.Path & "\test.txt" For Output As #1: Print #1, ss: Close #1
MsgBox ss
End Sub

Answer 4

没有规划Function或者Sub了,例子如下一个Sub里面
Option ExplicitPrivate Sub Command1_Click()
Text1.Text = ""'初始化字串/数组
Dim A As String
Dim B As String
Dim arryA As Variant
Dim arryB As VariantA = "a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12"
B = "b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14,b15,b16,b17,b18,b19,b20,b21"arryA = Split(A, ",")
arryB = Split(B, ",")'定义结果集,排列
Dim arryResultA((12 * 11 * 10) / (3 * 2 * 1) - 1) As String
Dim arryResultB((21 * 20 * 19) / (3 * 2 * 1) - 1) As StringDim i As Integer
Dim j As Integer
Dim k As Integer
Dim iCount As Integer'循环取3个arryA中的三个不同元素
For i = 0 To UBound(arryA)
  For j = 0 To UBound(arryA)
        If arryA(i) = arryA(j) Then Exit For
    For k = 0 To UBound(arryA)
            If arryA(k) = arryA(i) Or arryA(k) = arryA(j) Then Exit For
                arryResultA(iCount) = arryA(i) & "-" & arryA(j) & "-" & arryA(k)
                iCount = iCount + 1
    Next
  Next
NextiCount = 0'循环取3个arryB中的三个不同元素
For i = 0 To UBound(arryB)
  For j = 0 To UBound(arryB)
        If arryB(i) = arryB(j) Then Exit For
    For k = 0 To UBound(arryB)
            If arryB(k) = arryB(i) Or arryB(k) = arryB(j) Then Exit For
                arryResultB(iCount) = arryB(i) & "-" & arryB(j) & "-" & arryB(k)
                iCount = iCount + 1
    Next
  Next
Next'输出到文件
If Dir("d:\result.txt") <> "" Then Kill ("d:\result.txt")
Open "d:\result.txt" For Output As #1
Close #1'瞬间生成, WIN7 X64 E8200 3.2GX2
Open "d:\result.txt" For Append As #1
For i = 0 To UBound(arryResultA)
  For j = 0 To UBound(arryResultB)
     Print #1, arryResultA(i) & "-" & arryResultB(j)
  Next
Next
Close #1
End Sub

Answer 5

Option Explicit
Dim iiStr() As String, ii As LongPrivate Sub Command1_Click()
  Dim istr1 As String, istr2 As String, i As Integer
  istr1 = "a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12"
  istr2 = "b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14,b15,b16,b17,b18,b19,b20,b21"
  Dim sistr1() As String, sistr2() As String, sistr3(5)
  sistr1 = Split(istr1, ",")
  sistr2 = Split(istr2, ",")
  irda sistr1
  irda sistr2
  For i = 0 To 5
      If i <= 2 Then
         sistr3(i) = sistr1(i)
      Else
         sistr3(i) = sistr2(i)
      End If
  Next
  pai sistr3, 0, 6
  Open "c:\" & Format(Now, "hhmmss") & ".txt" For Output As #1
  Print #1, Join(iiStr, vbCrLf)
  Close #1
  ReDim iiStr(0)
  ii = 0
End SubPrivate Sub irda(x() As String)
    Dim i As Integer, temp  As String, j As Integer
    j = UBound(x)
    For i = 0 To j
       temp = x(i)
       x(i) = x(Int(Rnd * j))
       x(Int(Rnd(0) * j)) = temp
    Next
  
End SubSub chang(a(), m As Integer)
   Dim i As Integer, j As Integer
   Dim temp As String
   temp = a(0)
   For i = 0 To m - 1
       a(i) = a(i + 1)
   Next
   a(i) = temp
End SubSub pai(a(), m As Integer, n As Integer)
    Dim k As Integer
    If m < n Then
       For k = 0 To m
           pai a, m + 1, n
           chang a, m
       Next
    Else
       ReDim Preserve iiStr(ii)
       iiStr(ii) = Join(a, ",")
       ii = ii + 1
       DoEvents
    End If
   
End Sub