急急急~~VB中实现排列组合的问题
要求给出一个字符串能算出其中的任意N个字符的排列的可能性还要求任意两种可能性不重复并在Form中显示出来比如:txt,2个字符一组则结果为:tx,tt,xt,要求有原代码...
要求给出一个字符串能算出其中的任意N个字符的排列的可能性
还要求任意两种可能性不重复
并在Form中显示出来
比如:txt,2个字符一组
则结果为:tx,tt,xt,
要求有原代码的
老师要的急,大家来帮帮忙呀
分不是问题,看情况追加~ 展开
还要求任意两种可能性不重复
并在Form中显示出来
比如:txt,2个字符一组
则结果为:tx,tt,xt,
要求有原代码的
老师要的急,大家来帮帮忙呀
分不是问题,看情况追加~ 展开
展开全部
很巧~
我刚帮另一个网友研究过这个问题
他是要求每个组合里无重复字符的
把程序稍加修改就可以用到你这里了
程序中用到了text1(输入字符串)
text2(输入每字符的个数)
text3(输出显示)
text3要设置为多行显示,带滚动条的
Option Base 1
Dim SJNum As Double
Dim CF As Boolean
Dim ShuJu() As String
Dim OutStr As String
Dim I As Double
Dim ZhanStr() As String
Dim ZhanNum() As Double
Dim ZhanI() As Double
Dim ZhanOutStr() As String
Dim ZhiZhen As Double
Private Sub Command1_Click()
ReDim ShuJu(1)
ReDim ZhanStr(1)
ReDim ZhanNum(1)
ReDim ZhanI(1)
ReDim ZhanOutStr(1)
CF = False
SJNum = 0
ZhiZhen = 1
OutStr = ""
Text3.Text = ""
Dim ii As Double
Dim jj As Double
Dim NN As Double
Dim Str As String
If Len(Trim(Text1.Text)) <> 0 And IsNumeric(Text2.Text) And Len(Trim(Text1.Text)) >= Val(Text2.Text) Then
Str = ""
If Len(Trim(Text1.Text)) = 1 Then
Str = Trim(Text1.Text)
Else
For ii = 1 To Len(Trim(Text1.Text)) - 1
If InStr(ii + 1, Trim(Text1.Text), Mid(Trim(Text1.Text), ii, 1)) = 0 Then
Str = Str & Mid(Trim(Text1.Text), ii, 1)
End If
Next ii
Str = Str & Mid(Trim(Text1.Text), Len(Trim(Text1.Text)), 1)
End If
If Len(Str) < Val(Text2.Text) Then
MsgBox "不重复字符为:" & Len(Str) & "<" & Val(Text2.Text)
Exit Sub
End If
Call OutPrint(Str, Val(Text2.Text))
NN = 0
If SJNum = 1 Then
Print ShuJu(SJNum)
Else
For ii = 1 To SJNum - 1
For jj = ii + 1 To SJNum
If ShuJu(jj) = ShuJu(ii) Then
CF = True
Exit For
End If
Next jj
If CF = False Then
NN = NN + 1
Text3.Text = Text3.Text & ShuJu(ii) & " "
If NN Mod 10 = 0 Then Text3.Text = Text3.Text & vbCrLf
Else
CF = False
End If
Next ii
NN = NN + 1
Text3.Text = Text3.Text & ShuJu(SJNum)
End If
Text3.Text = Text3.Text & vbCrLf
Text3.Text = Text3.Text & "共有" & SJNum & "种可能性" & vbCrLf
End If
End Sub
Private Sub OutPrint(ByVal NowStr As String, ByVal Num As Double)
If Num = 0 Then
If Len(OutStr) > Val(Text2.Text) Then OutStr = Right(OutStr, Val(Text2.Text))
SJNum = SJNum + 1
ReDim Preserve ShuJu(SJNum)
ShuJu(SJNum) = OutStr
'Print OutStr
Else
For I = 1 To Len(NowStr)
Call JinZhan(NowStr, Num, I, OutStr)
OutStr = OutStr & Mid(NowStr, I, 1)
NowStr = Left(NowStr, I - 1) & Right(NowStr, Len(NowStr) - I)
Call OutPrint(NowStr, Num - 1)
Call ChuZhan(NowStr, Num, I, OutStr)
Next I
End If
End Sub
Private Sub JinZhan(ByVal NowStr1 As String, ByVal Num1 As Double, ByVal I1 As Double, ByVal OutStr1 As String)
ZhiZhen = ZhiZhen + 1
ReDim Preserve ZhanStr(ZhiZhen)
ReDim Preserve ZhanNum(ZhiZhen)
ReDim Preserve ZhanI(ZhiZhen)
ReDim Preserve ZhanOutStr(ZhiZhen)
ZhanStr(ZhiZhen) = NowStr1
ZhanNum(ZhiZhen) = Num1
ZhanI(ZhiZhen) = I1
ZhanOutStr(ZhiZhen) = OutStr1
End Sub
Private Sub ChuZhan(ByRef NowStr2 As String, ByRef Num2 As Double, ByRef I2 As Double, ByRef OutStr2 As String)
NowStr2 = ZhanStr(ZhiZhen)
Num2 = ZhanNum(ZhiZhen)
I2 = ZhanI(ZhiZhen)
OutStr2 = ZhanOutStr(ZhiZhen)
ZhiZhen = ZhiZhen - 1
ReDim Preserve ZhanStr(ZhiZhen)
ReDim Preserve ZhanNum(ZhiZhen)
ReDim Preserve ZhanI(ZhiZhen)
ReDim Preserve ZhanOutStr(ZhiZhen)
End Sub
希望对你有帮助
有问题的话再联系我吧~
我刚帮另一个网友研究过这个问题
他是要求每个组合里无重复字符的
把程序稍加修改就可以用到你这里了
程序中用到了text1(输入字符串)
text2(输入每字符的个数)
text3(输出显示)
text3要设置为多行显示,带滚动条的
Option Base 1
Dim SJNum As Double
Dim CF As Boolean
Dim ShuJu() As String
Dim OutStr As String
Dim I As Double
Dim ZhanStr() As String
Dim ZhanNum() As Double
Dim ZhanI() As Double
Dim ZhanOutStr() As String
Dim ZhiZhen As Double
Private Sub Command1_Click()
ReDim ShuJu(1)
ReDim ZhanStr(1)
ReDim ZhanNum(1)
ReDim ZhanI(1)
ReDim ZhanOutStr(1)
CF = False
SJNum = 0
ZhiZhen = 1
OutStr = ""
Text3.Text = ""
Dim ii As Double
Dim jj As Double
Dim NN As Double
Dim Str As String
If Len(Trim(Text1.Text)) <> 0 And IsNumeric(Text2.Text) And Len(Trim(Text1.Text)) >= Val(Text2.Text) Then
Str = ""
If Len(Trim(Text1.Text)) = 1 Then
Str = Trim(Text1.Text)
Else
For ii = 1 To Len(Trim(Text1.Text)) - 1
If InStr(ii + 1, Trim(Text1.Text), Mid(Trim(Text1.Text), ii, 1)) = 0 Then
Str = Str & Mid(Trim(Text1.Text), ii, 1)
End If
Next ii
Str = Str & Mid(Trim(Text1.Text), Len(Trim(Text1.Text)), 1)
End If
If Len(Str) < Val(Text2.Text) Then
MsgBox "不重复字符为:" & Len(Str) & "<" & Val(Text2.Text)
Exit Sub
End If
Call OutPrint(Str, Val(Text2.Text))
NN = 0
If SJNum = 1 Then
Print ShuJu(SJNum)
Else
For ii = 1 To SJNum - 1
For jj = ii + 1 To SJNum
If ShuJu(jj) = ShuJu(ii) Then
CF = True
Exit For
End If
Next jj
If CF = False Then
NN = NN + 1
Text3.Text = Text3.Text & ShuJu(ii) & " "
If NN Mod 10 = 0 Then Text3.Text = Text3.Text & vbCrLf
Else
CF = False
End If
Next ii
NN = NN + 1
Text3.Text = Text3.Text & ShuJu(SJNum)
End If
Text3.Text = Text3.Text & vbCrLf
Text3.Text = Text3.Text & "共有" & SJNum & "种可能性" & vbCrLf
End If
End Sub
Private Sub OutPrint(ByVal NowStr As String, ByVal Num As Double)
If Num = 0 Then
If Len(OutStr) > Val(Text2.Text) Then OutStr = Right(OutStr, Val(Text2.Text))
SJNum = SJNum + 1
ReDim Preserve ShuJu(SJNum)
ShuJu(SJNum) = OutStr
'Print OutStr
Else
For I = 1 To Len(NowStr)
Call JinZhan(NowStr, Num, I, OutStr)
OutStr = OutStr & Mid(NowStr, I, 1)
NowStr = Left(NowStr, I - 1) & Right(NowStr, Len(NowStr) - I)
Call OutPrint(NowStr, Num - 1)
Call ChuZhan(NowStr, Num, I, OutStr)
Next I
End If
End Sub
Private Sub JinZhan(ByVal NowStr1 As String, ByVal Num1 As Double, ByVal I1 As Double, ByVal OutStr1 As String)
ZhiZhen = ZhiZhen + 1
ReDim Preserve ZhanStr(ZhiZhen)
ReDim Preserve ZhanNum(ZhiZhen)
ReDim Preserve ZhanI(ZhiZhen)
ReDim Preserve ZhanOutStr(ZhiZhen)
ZhanStr(ZhiZhen) = NowStr1
ZhanNum(ZhiZhen) = Num1
ZhanI(ZhiZhen) = I1
ZhanOutStr(ZhiZhen) = OutStr1
End Sub
Private Sub ChuZhan(ByRef NowStr2 As String, ByRef Num2 As Double, ByRef I2 As Double, ByRef OutStr2 As String)
NowStr2 = ZhanStr(ZhiZhen)
Num2 = ZhanNum(ZhiZhen)
I2 = ZhanI(ZhiZhen)
OutStr2 = ZhanOutStr(ZhiZhen)
ZhiZhen = ZhiZhen - 1
ReDim Preserve ZhanStr(ZhiZhen)
ReDim Preserve ZhanNum(ZhiZhen)
ReDim Preserve ZhanI(ZhiZhen)
ReDim Preserve ZhanOutStr(ZhiZhen)
End Sub
希望对你有帮助
有问题的话再联系我吧~
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询