Question

VB 数组的组合

Text1.text取放数据（格式12345 01234 等等。中间空格形式，点击按钮得到
每个数组组成三位数，并从小到大排列，中间是空格。比如12345 那么组成的123 124 125 134 135 234 235 245 而01234组成的数为 012 013 014 023 024 123 124 234 034
text2.text即点击按钮后得到123 124 125 134 135 234 235 245 012 013 014 023 024 123 124 234 034
但是这里Text2.text不能有重复的出现，如果有则去下重复，还有个要求是如果生成的组合是231那么要变成从小到大的123，也就是位置要转变下。
帮下吧。。谢谢了。。
先将TEXT1。TEXT里的每个数组（5位数） 每个5位数，万千百十个位组合排列成3个数，再将得到的数据（3位数的数组）按从小到大转，（比如得到152 132 转成125 123 ），得到的数据去重复下！！

Answer 1

早上发过一遍没有显示成功，再发一遍。试验过可以的··呵呵
Option Explicit

Private Sub Command1_Click()
Dim a, b() As String, c() As String, i As Integer
Dim temp As String, j As Integer, k As Integer, l As Integer, t As Integer
a = Split(Text1, " ") '以空格为分隔符，将输入的数字输入数组中
ReDim c(10 * UBound(a) + 10) '因为每一个5位数能够产生的数字不重复的3位数最多为C5(3)=10个，所以就这么设定
ReDim b(10 * UBound(a) + 10)

For i = 0 To UBound(a) '三个数为一组录入数组
For j = 1 To 3
For k = j + 1 To 4
For l = k + 1 To 5
c(t) = Mid(a(i), j, 1) & Mid(a(i), k, 1) & Mid(a(i), l, 1)
t = t + 1
Next
Next
Next
Next

For i = 0 To 10 * UBound(a) + 10 '从小到大排序
For k = 1 To 2
For l = k To 3
If Val(Mid(c(i), k, 1)) > Val(Mid(c(i), l, 1)) Then
temp = Mid(c(i), k, 1)
Mid(c(i), k, 1) = Mid(c(i), l, 1)
Mid(c(i), l, 1) = temp
End If
Next
Next
Next

t = 0 '排除相同的
For i = 0 To UBound(a) * 10 + 9
For j = i + 1 To UBound(a) * 10 + 10
If c(i) = c(j) Then GoTo hh
Next
b(t) = c(i)
t = t + 1
hh:
Next

For i = 0 To t '输出结果
Text2 = Text2 & b(i) & " "
Next
End Sub

Answer 2

来个更简洁的：
Private Sub Command1_Click()
Dim i As Integer, a() As String, S As String
Dim j As Integer, k As Integer, m As Integer, n As Integer, p As Integer
Dim t(1 To 3) As String, t1 As String
a = Split(Text1.Text, " ")
For m = 0 To UBound(a)
If Len(a(m)) = 5 Then
For i = 1 To 3
For j = i + 1 To 4
For k = j + 1 To 5
'得到数值
t(1) = Mid(a(m), i, 1)
t(2) = Mid(a(m), j, 1)
t(3) = Mid(a(m), k, 1)
For n = 1 To 3 '排序
For p = n + 1 To 3
If t(n) > t(p) Then
t1 = t(n)
t(n) = t(p)
t(p) = t1
End If
Next
Next
t1 = t(1) & t(2) & t(3)
If InStr(S, t1) = 0 Then S = S & t1 & " " '过滤
Next
Next
Next
End If
Next
Text2.Text = S
End Sub

Answer 3

Private Sub Command1_Click()
Dim myInput() As String, i As Integer, j As Integer, k As Integer, m As Integer, myTempstr As String, myOutput As String
myInput = Split(Text1.Text, " ")
For i = 0 To UBound(myInput)
If myInput(i) <> "" Then
For j = 1 To Len(myInput(i)) - 2
For k = j + 1 To Len(myInput(i)) - 1
For m = k + 1 To Len(myInput(i))
myTempstr = Mid(myInput(i), j, 1) & Mid(myInput(i), k, 1) & Mid(myInput(i), m, 1)
If InStr(1, myOutput, zhzsucyg(myTempstr)) = 0 Then myOutput = myOutput & zhzsucyg(myTempstr) & " "
Next
Next
Next
End If
Next
Text2.Text = myOutput
End Sub
Private Function zhzsucyg(myStr As String) As String
Dim a(3) As Integer, mytemp As Integer, i As Integer, myMax As Integer, myMin As Integer
For i = 1 To 3
a(i) = Mid(myStr, i, 1)
Next
myMax = 0: myMin = 9
For i = 1 To 3
If a(i) > myMax Then myMax = a(i)
If a(i) < myMin Then myMin = a(i)
Next
mytemp = Replace(myStr, myMax, "")
mytemp = Replace(mytemp, myMin, "")
zhzsucyg = CStr(myMin) & mytemp & CStr(myMax)
End Function

Answer 4

Private Sub Command1_Click()
Dim i&, j&, k&, l&, m&, tmp$, x&(4), b$()
ReDim b(0)
a = Split(Trim(Text1), " ")
For i = 0 To UBound(a)
For j = 0 To 4
x(j) = Mid(a(i), j + 1, 1)
Next
Quick_Sort x, 0, 4
For j = 0 To 4
For k = j + 1 To 4
For l = k + 1 To 4
tmp = x(j) & x(k) & x(l)
For m = 0 To UBound(b)
If tmp = b(m) Then Exit For
Next
If m > UBound(b) Then
ReDim Preserve b(UBound(b) + 1)
b(UBound(b)) = tmp
End If
Next
Next
Next
Next
Text2 = Trim(Join(b, " "))
End Sub

Private Sub Quick_Sort(SortArray() As Long, ByVal First As Long, ByVal Last As Long)
Dim Temp As Long, Low As Long, High As Long
Dim List_Separator As Long
Low = First
High = Last
List_Separator = SortArray((First + Last) / 2)
Do
Do While (SortArray(Low) < List_Separator)
Low = Low + 1
Loop
Do While (SortArray(High) > List_Separator)
High = High - 1
Loop
If (Low <= High) Then
Temp = SortArray(Low)
SortArray(Low) = SortArray(High)
SortArray(High) = Temp
Low = Low + 1
High = High - 1
End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last
End Sub

'修改后所有结果从小到大排列
Private Sub Command1_Click()
Dim i&, j&, k&, l&, m&, n&, tmp$, x&(4), b$(), c&()
n = -1
a = Split(Trim(Text1), " ")
For i = 0 To UBound(a)
For j = 0 To 4
x(j) = Mid(a(i), j + 1, 1)
Next
Quick_Sort x, 0, 4
For j = 0 To 4
For k = j + 1 To 4
For l = k + 1 To 4
tmp = x(j) & x(k) & x(l)
If n = -1 Then
n = n + 1
ReDim b(n)
b(n) = tmp
Else
For m = 0 To n
If tmp = b(m) Then Exit For
Next
If m > n Then
n = n + 1
ReDim Preserve b(n)
b(n) = tmp
End If
End If
Next
Next
Next
Next
ReDim c(n)
For i = 0 To n
c(i) = b(i)
Next
Quick_Sort c, 0, n
For i = 0 To n
b(i) = Format(c(i), "000")
Next
Text2 = Trim(Join(b, " "))
End Sub

Private Sub Quick_Sort(SortArray&(), ByVal First&, ByVal Last&)
Dim Temp As Long, Low As Long, High As Long
Dim List_Separator As Long
Low = First
High = Last
List_Separator = SortArray((First + Last) / 2)
Do
Do While (SortArray(Low) < List_Separator)
Low = Low + 1
Loop
Do While (SortArray(High) > List_Separator)
High = High - 1
Loop
If (Low <= High) Then
Temp = SortArray(Low)
SortArray(Low) = SortArray(High)
SortArray(High) = Temp
Low = Low + 1
High = High - 1
End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last
End Sub

Answer 5

先把Text1里的内容排下序,然后三层循环for a=1 to 3,for b=a+1 to 4,for c=b+1 to 5,然后直接拼接abc即可.