VB运算 大小排序
发布网友
发布时间：2022-05-23 19:57
共3个回答
热心网友
时间：2023-11-19 10:25
Private Sub Command1_Click()
Dim strArray() As String, intArray() As Integer, strArray1() As String, strConversionArray() As String
Dim x(6), y(6), z(6), intOneDimensionalArray() As Integer
Text1.Text = Trim(Text1.Text)
strArray = Split(Text1.Text, " ")
ReDim strArray1(UBound(strArray) - LBound(strArray), 3), strConversionArray(UBound(strArray) - LBound(strArray), 6)
For i = LBound(strArray) To UBound(strArray)
For j = 1 To 3
strArray1(i, j) = Mid(strArray(i), j, 1)
Next j
Next i
ReDim strConversionArray(UBound(strArray) - LBound(strArray), 6)
For i = 1 To 6
x(i) = (i + 1) \ 2
Next i
y(1) = 2: y(2) = 3: y(3) = 1: y(4) = 3: y(5) = 1: y(6) = 2
z(1) = 3: z(2) = 2: z(3) = 3: z(4) = 1: z(5) = 2: z(6) = 1
For i = LBound(strArray) To UBound(strArray)
For j = 1 To 6
strConversionArray(i, j) = strArray1(i, x(j)) + strArray1(i, y(j)) + strArray1(i, z(j))
Next j
Next i
ReDim intArray(UBound(strArray) - LBound(strArray), 6)
For i = LBound(strArray) To UBound(strArray)
For j = 1 To 6
intArray(i, j) = Val(strConversionArray(i, j))
Next j
Next i
ReDim intOneDimensionalArray(((UBound(strArray) - LBound(strArray)) + 1) * 6)
For i = LBound(strArray) To UBound(strArray)
For j = 1 To 6
intOneDimensionalArray(r) = intArray(i, j)
r = r + 1
Next j
Next i
For i = LBound(intOneDimensionalArray) To UBound(intOneDimensionalArray) - 1
For j = i + 1 To UBound(intOneDimensionalArray)
If intOneDimensionalArray(j) < intOneDimensionalArray(i) Then
t = intOneDimensionalArray(i)
intOneDimensionalArray(i) = intOneDimensionalArray(j)
intOneDimensionalArray(j) = t
End If
Next j
Next i
For i = LBound(intOneDimensionalArray) + 1 To UBound(intOneDimensionalArray)
Text2.Text = Text2.Text + CStr(intOneDimensionalArray(i)) + Space(1)
Next i
End Sub
热心网友
时间：2023-11-19 10:26
Private Sub Command1_Click()
Dim a, b$(), c$(), n%, m%, q%
If Text1 = "" Then
MsgBox "请输入几个三位数！"
End
End If
a = Split(Text1, " ")
n = UBound(a)
m = 1
ReDim b(1 To 3, n)
For i = 0 To n
For j = 1 To 3
b(j, i) = Mid(a(i), j, 1)
Next j
Next i
q = 0
ReDim c(m)
Do While q <= n
For i = 1 To 3
For j = 1 To 3
For k = 1 To 3
If i <> j And j <> k And k <> i Then
c(m) = b(i, q) & b(j, q) & b(k, q)
m = m + 1
ReDim Preserve c(m)
End If
Next k
Next j
Next i
q = q + 1
Loop
For i = 1 To m
For j = 1 To m - i
If c(j) > c(j + 1) Then
t = c(j): c(j) = c(j + 1): c(j + 1) = t
End If
Next j
Next i
For i = 1 To m
Text2 = Text2 & c(i) & " "
Next i
End Sub
Private Sub Form_Load()
Text1 = "": Text2 = ""
End Sub
热心网友
时间：2023-11-19 10:26
一个重新组合
一个排序。
