Dim strr, okstrr, okstrarry, strcheck(999), mycount, standardstr Private Sub Form_Load() Me.Hide Open App.Path & "\in.txt" For Input As #1 Open App.Path & "\out.txt" For Output As #2 Input #1, strr ReDim okstrarry(Len(strr)) For i = 1 To Len(strr) okstrr = okstrr & "(" & Mid(strr, i, 1) & Chr(64 + i) & ")" standardstr = okstrr okstrarry(i) = "(" & Mid(strr, i, 1) & Chr(64 + i) & ")" Next Call rr("") Print #2, mycount For ii = 1 To mycount Print #2, strcheck(ii) Next Close #2 Close #1 End End Sub
Public Function rr(k As String) If Len(k) = Len(standardstr) Then For i = 1 To Len(strr) k = Replace(k, Chr(64 + i), "") Next k = Replace(k, "(", "") k = Replace(k, ")", "") For ii = 1 To mycount + 1 If strcheck(ii) = k Then Exit For If ii = mycount + 1 Then strcheck(ii) = k: mycount = mycount + 1 Next
Else For i = 1 To Len(strr) If InStr(k, okstrarry(i)) = 0 Then Call rr(k & okstrarry(i)) Next End If End Function
Dim a() As String Dim d() As String Dim x As String Dim r, all, g() As Integer Private Sub Form_Load() Me.Hide Open App.Path & "\in.txt" For Input As #1 Open App.Path & "\out.txt" For Output As #2 Input #1, x ReDim a(Len(x)), g(Len(x)) For i = 1 To Len(x) a(i) = Mid(x, i, 1): g(i) = i Next i r = 1: all = 0 Call b("", "") Print #2, all For i = 1 To UBound(d) If d(i) <> "" Then Print #2, d(i) Next i Close #2 Close #1 End End Sub Sub b(c, f) If Len(c) = Len(x) Then ReDim Preserve d(r) If r = 1 Then d(r) = f: r = r + 1: all = all + 1 Else For i = 1 To UBound(d) - 1 If f = d(i) Then Exit For If i = UBound(d) - 1 And f <> d(i) Then d(UBound(d)) = f: r = r + 1: all = all + 1 Next i End If Else For i = 1 To UBound(g) If InStr(c, g(i)) = 0 Then Call b(c & g(i), f & a(i)) Next i End If End Sub
Dim strr, okstrr, okstrarry, strcheck(999), mycount, standardstr
回覆刪除Private Sub Form_Load()
Me.Hide
Open App.Path & "\in.txt" For Input As #1
Open App.Path & "\out.txt" For Output As #2
Input #1, strr
ReDim okstrarry(Len(strr))
For i = 1 To Len(strr)
okstrr = okstrr & "(" & Mid(strr, i, 1) & Chr(64 + i) & ")"
standardstr = okstrr
okstrarry(i) = "(" & Mid(strr, i, 1) & Chr(64 + i) & ")"
Next
Call rr("")
Print #2, mycount
For ii = 1 To mycount
Print #2, strcheck(ii)
Next
Close #2
Close #1
End
End Sub
Public Function rr(k As String)
If Len(k) = Len(standardstr) Then
For i = 1 To Len(strr)
k = Replace(k, Chr(64 + i), "")
Next
k = Replace(k, "(", "")
k = Replace(k, ")", "")
For ii = 1 To mycount + 1
If strcheck(ii) = k Then Exit For
If ii = mycount + 1 Then strcheck(ii) = k: mycount = mycount + 1
Next
Else
For i = 1 To Len(strr)
If InStr(k, okstrarry(i)) = 0 Then Call rr(k & okstrarry(i))
Next
End If
End Function
Dim a() As String
回覆刪除Dim d() As String
Dim x As String
Dim r, all, g() As Integer
Private Sub Form_Load()
Me.Hide
Open App.Path & "\in.txt" For Input As #1
Open App.Path & "\out.txt" For Output As #2
Input #1, x
ReDim a(Len(x)), g(Len(x))
For i = 1 To Len(x)
a(i) = Mid(x, i, 1): g(i) = i
Next i
r = 1: all = 0
Call b("", "")
Print #2, all
For i = 1 To UBound(d)
If d(i) <> "" Then Print #2, d(i)
Next i
Close #2
Close #1
End
End Sub
Sub b(c, f)
If Len(c) = Len(x) Then
ReDim Preserve d(r)
If r = 1 Then
d(r) = f: r = r + 1: all = all + 1
Else
For i = 1 To UBound(d) - 1
If f = d(i) Then Exit For
If i = UBound(d) - 1 And f <> d(i) Then d(UBound(d)) = f: r = r + 1: all = all + 1
Next i
End If
Else
For i = 1 To UBound(g)
If InStr(c, g(i)) = 0 Then Call b(c & g(i), f & a(i))
Next i
End If
End Sub