第1个回答 2010-08-14
楼上可能理解错误,要求是六个数字中任意选五个数字组合.实际组合有120个.下面代码能实现这个要求:
Sub Filter()
Dim sInput As String, Arr()
Dim a As String, i&, c%, j%, r%, n&, m&, d&, e&
[a:a] = ""
Application.ScreenUpdating = False
a = 234567
sInput = InputBox("请在【" & a & "】六个数字中任意选五个数字:", "数字组合", "")
If Len(Trim(sInput)) = 5 Then
ReDim Arr(1 To 5)
For i = 1 To 5
Cells(i, 1) = Mid(sInput, i, 1)
Next
For i = 1 To 5
n = n & Application.Small(Range("a1:a5"), i)
m = m & Application.Large(Range("a1:a5"), i)
Next
For i = 1 To 6
If InStr(sInput, Mid(a, i, 1)) = 0 Then
c = Mid(a, i, 1)
End If
Next
For i = n To m
For r = 1 To 5
If InStr(sInput, Mid(i, r, 1)) > 0 Then
e = e + 1
If InStr(i, Mid(sInput, r, 1)) = InStrRev(i, Mid(sInput, r, 1)) Then
d = d + 1
End If
End If
Next
If InStr(i, c) = 0 And d = 5 And e = 5 Then
j = j + 1
Cells(j, 1) = i
End If
e = 0: d = 0
Next
End If
MsgBox "数字【" & sInput & "】共有组合【" & j & "】种!"
Application.ScreenUpdating = True
End Sub