一道智力问答题:
答案是C,D,E,B,E,E,D,C,B,A,
1、第一个答案是b的问题是哪一个？
（a）2；（b） 3；（c）4；（d）5；（e）6
2、唯一的连续两个具有相同答案的问题是：
（a）2，3；（b）3，4；（c）4，5；（d）5，6；（e）6，7；
3、本问题答案和哪一个问题的答案相同？
（a）1；（b）2；（c）4；（d）7；（e）6
4、答案是a的问题的个数是：
（a）0；（b）1；（c）2；（d）3；（e）4
5、本问题答案和哪一个问题的答案相同？
（a）10；（b）9；（c）8；（d）7；（e）6
6、答案是a的问题的个数和答案是什么的问题的个数相同？
（a）b；（b）c；（c）d；（d）e；（e）以上都不是
7、按照字母顺序，本问题的答案和下一个问题的答案相差几个字母？
（a）4；（b）3；（c）2；（d）1；（e）0。（注：a和b相差一个字母）
8、答案是元音字母的问题的个数是：
（a）2；（b）3；（c）4；（d）5；（e）6。（注：a和e是元音字母）
9、答案是辅音字母的问题的个数是：
（a）一个质数；（b）一个阶乘数；（c）一个平方数；（d）一个立方数，（e）5的倍数
10、本问题的答案是：
（a）a；（b）b；（c）c；（d）d；（e）e
下面是Roadbeg(顾先强)给出的解决代码:
Public Function Test()
Dim lng1 As Long, lng2 As Long, lng3 As Long, lng4 As Long, lng5 As Long, lng6 As Long
Dim lng7 As Long, lng8 As Long, lng9 As Long, lng0 As Long
Dim lng(9) As Long, lngI As Long, lngJ As Long, lngK As Long
Dim lngCount(4) As Long '统计所有答案为 A(b,c,d,e) 的题目数量
Dim lngCountAE As Long, lngCountBCD As Long
Dim strMsg As String
Dim lngLast As Long, lngR As Long, blnFind As Boolean '连续的重复的答案的个数
Const clngNum As Long = 4 '共有5种答案
'已经有的推理:
'下面加了一些简单的推理,后面一些就没加了,因为计算速度够快,多几万,几十万次循环也无所谓
Debug.Print "Start:" & CStr(Timer())
For lng0 = 0 To clngNum
lng(0) = lng0
For lng1 = 0 To clngNum
lng(1) = lng1
For lng2 = 0 To clngNum
lng(2) = lng2
If lng2 = 1 Then GoTo Next3
For lng3 = 0 To clngNum
lng(3) = lng3
If lng3 = 0 Then GoTo Next4
For lng4 = 0 To clngNum
lng(4) = lng4
For lng5 = 0 To clngNum
lng(5) = lng5
For lng6 = 0 To clngNum
lng(6) = lng6
For lng7 = 0 To clngNum
lng(7) = lng7
For lng8 = 0 To clngNum
lng(8) = lng8
For lng9 = 0 To clngNum
lng(9) = lng9
'执行验证过程
'验证的时候,调整一下验证的次序应该会更快一点
lngK = 10
For lngI = 0 To clngNum '清除统计数据
lngCount(lngI) = 0
Next
lngLast = -1: lngR = 0
blnFind = False '还未找到连续的
For lngI = 0 To 9
If lng(lngI) = lngLast Then
lngR = lngR + 1
If lngR > 1 Then GoTo NextFor '有三个以上连续,不正确
If lngR Then
If blnFind Then
GoTo NextFor '前面已经有连续的了,不正确
Else
blnFind = True
End If
End If
Else
lngLast = lng(lngI)
End If
'这是为了第一题而计算的
If lng(lngI) = 1 And lngK = 10 Then '只在第一次遇到B时,设置 lngK 的值
lngK = lngI
End If
'统计每一个答案的数量
lngCount(lng(lngI)) = lngCount(lng(lngI)) + 1
Next
lngCountAE = lngCount(0) + lngCount(4) '元音的个数,即 a,e 的个数
lngCountBCD = 10 - lngCountAE '辅音,即 bcd 的个数
'------------------------------------------------------------
'首先判断 第一题
'1、第一个答案是b的问题是哪一个？
'（a）2；（b） 3；（c）4；（d）5；（e）6
If lngK > 10 Then
'没找到答案是B的
GoTo NextFor '进入下一循环,答案错误
End If
If lngK <> lng(0) + 1 Then GoTo NextFor
'------------------------------------------------------------
'第二题:
'2、唯一的连续两个具有相同答案的问题是：
'（a）2，3；（b）3，4；（c）4，5；（d）5，6；（e）6，7\
'这个问题,前面已经进行了部分验证
If lng(lng(1) + 1) <> lng(lng(1) + 2) Then GoTo NextFor
'------------------------------------------------------------
'第三题:
'3、本问题答案和哪一个问题的答案相同？
'（a）1；（b）2；（c）4；（d）7；（e）6
Select Case lng(2)
Case 0, 1
If lng(lng(2)) <> lng(2) Then GoTo NextFor
Case 2, 4
If lng(lng(2) + 1) <> lng(2) Then GoTo NextFor
Case 3
If lng(6) <> lng(2) Then GoTo NextFor
End Select
'------------------------------------------------------------
'第四题:
'4、答案是a的问题的个数是：
'（a）0；（b）1；（c）2；（d）3；（e）4
If lng(3) <> lngCount(0) Then GoTo NextFor
'------------------------------------------------------------
'第五题:
'5、本问题答案和哪一个问题的答案相同？
'（a）10；（b）9；（c）8；（d）7；（e）6
If lng(4) <> lng(9 - lng(4)) Then GoTo NextFor
'------------------------------------------------------------
'第六题:
'6、答案是a的问题的个数和答案是什么的问题的个数相同？
'（a）b；（b）c；（c）d；（d）e；（e）以上都不是
Select Case lng(5)
Case 0, 1, 2, 3
If lngCount(0) <> lngCount(lng(5) + 1) Then GoTo NextFor
Case 4
If lngCount(0) = lngCount(1) Or lngCount(0) = lngCount(2) _
Or lngCount(0) = lngCount(3) Or lngCount(0) = lngCount(4) Then _
GoTo NextFor
End Select
'------------------------------------------------------------
'第七题:
'7、按照字母顺序，本问题的答案和下一个问题的答案相差几个字母？
'（a）4；（b）3；（c）2；（d）1；（e）0（注：a和b相差一个字母）
If Abs(lng(7) - lng(6)) <> (4 - lng(6)) Then GoTo NextFor
'------------------------------------------------------------
'第八题:
'8、答案是元音字母的问题的个数是：
'（a）2；（b）3；（c）4；（d）5；（e）6（注：a和e是元音字母）
If lngCountAE = 5 Then GoTo NextFor '如果为5,则在第9题会矛盾
If lngCountAE <> lng(7) + 2 Then GoTo NextFor
'------------------------------------------------------------
'第九题:
'9、答案是辅音字母的问题的个数是：
'（a）一个质数；（b）一个阶乘数；（c）一个平方数；（d）一个立方数，（e）5的倍数
Select Case lng(8)
Case 1 'b
If lngCountBCD <> 6 Then GoTo NextFor '阶
Case 2
If lngCountBCD <> 4 Then GoTo NextFor '平方
Case 3
If lngCountBCD <> 8 Then GoTo NextFor '立方
Case 0 'a,本来是不用验证5 的
If lngCountBCD <> 7 And lngCountBCD <> 5 Then GoTo NextFor '质数
Case 4
'这里不用验证,因为上面已经验证了不能为5,不过为了表述明确,还是写上
If lngCountBCD <> 5 Then GoTo NextFor '5的倍数
GoTo NextFor '不能是5的倍数
End Select
'------------------------------------------------------------
'第十题:
'10 ?本问题的答案是:
'（a）a；（b）b；（c）c；（d）d；（e）e
'------------------------------------------------------------
'如果到这里还没有退出,则表示找到了答案
strMsg = ""
For lngI = 0 To 9
strMsg = strMsg & Chr$(lng(lngI) + 65) & ","
Next
strMsg = Left(strMsg, Len(strMsg) - 1)
If MsgBox("OK." & vbCrLf & strMsg & vbCrLf & "中止查找?", vbYesNo) = vbYes Then
Exit Function '退出
'如果不选Yes ,就继续找,看有没有其它答案
End If
NextFor:
Next
Next
Next
Next
Next
Next
Next4:
Next
Next3:
Next
Next
Next
Debug.Print "End:" & CStr(Timer())
MsgBox "没找到"
End Function
换一种解答，这样的写法是个人比较喜欢的，分拆，但是思路会更加清晰
'1、第一个答案是b的问题是哪一个？
'（a）2；（b） 3；（c）4；（d）5；（e）6
'2、唯一的连续两个具有相同答案的问题是：
'（a）2，3；（b）3，4；（c）4，5；（d）5，6；（e）6，7
'3、本问题答案和哪一个问题的答案相同？
'（a）1；（b）2；（c）4；（d）7；（e）6
'4、答案是a的问题的个数是：
'（a）0；（b）1；（c）2；（d）3；（e）4
'5、本问题答案和哪一个问题的答案相同？
'（a）10；（b）9；（c）8；（d）7；（e）6
'6、答案是a的问题的个数和答案是什么的问题的个数相同？
'（a）b；（b）c；（c）d；（d）e；（e）以上都不是
'7、按照字母顺序，本问题的答案和下一个问题的答案相差几个字母？
'（a）4；（b）3；（c）2；（d）1；（e）0（注：a和b相差一个字母）
'8、答案是元音字母(a,e)的问题的个数是：
'（a）2；（b）3；（c）4；（d）5；（e）6（注：a和e是元音字母）
'9、答案是辅音字母(b,c,d)的问题的个数是：
'（a）一个质数；（b）一个阶乘数；（c）一个平方数；（d）一个立方数，（e）5的倍数
'（a）2,3,5,7 （b）1,2,6 （c）1,4,9 （d）1,8 （e）5,10
'10、本问题的答案是：
'（a）a；（b）b；（c）c；（d）d；（e）e
Option Explicit
Private Enum eOPTIONS
A = 1
B = 2
C = 3
D = 4
E = 5
End Enum
Private x(1 To 10) As eOPTIONS
Private cnt(1 To 5) As Long, cntA As Long, cntZ As Long, cntY As Long, cntF As Long
Private opt As eOPTIONS
Private abOptions(1 To 5) As String
'1、第一个答案是b的问题是哪一个？
'（a）2；（b） 3；（c）4；（d）5；（e）6
Private Function fn1() As Boolean
opt = x(1)
Select Case opt
Case A
fn1 = (x(2) = B)
Case B
fn1 = (x(3) = B)
Case C
fn1 = (x(4) = B)
Case D
fn1 = (x(5) = B)
Case E
fn1 = (x(6) = B)
End Select
End Function
'2、唯一的连续两个具有相同答案的问题是：
'（a）2，3；（b）3，4；（c）4，5；（d）5，6；（e）6，7
Private Function fn2() As Boolean
opt = x(2)
Dim i As Long
Dim cnd1 As Boolean, cnd2 As Boolean
fn2 = True
For i = 1 To 10 - 1
Select Case opt
Case A
cnd2 = ((x(i) = x(i + 1)) And (i <> 2))
If cnd2 Then Exit For
cnd1 = IIf(cnd1, True, ((x(i) = x(i + 1)) And (i = 2)))
Case B
cnd2 = ((x(i) = x(i + 1)) And (i <> 3))
If cnd2 Then Exit For
cnd1 = IIf(cnd1, True, ((x(i) = x(i + 1)) And (i = 3)))
Case C
cnd2 = ((x(i) = x(i + 1)) And (i <> 4))
If cnd2 Then Exit For
cnd1 = IIf(cnd1, True, ((x(i) = x(i + 1)) And (i = 4)))
Case D
cnd2 = ((x(i) = x(i + 1)) And (i <> 5))
If cnd2 Then Exit For
cnd1 = IIf(cnd1, True, ((x(i) = x(i + 1)) And (i = 5)))
Case E
cnd2 = ((x(i) = x(i + 1)) And (i <> 6))
If cnd2 Then Exit For
cnd1 = IIf(cnd1, True, ((x(i) = x(i + 1)) And (i = 6)))
End Select
Next
fn2 = cnd1 And (Not cnd2)
End Function
'3、本问题答案和哪一个问题的答案相同？
'（a）1；（b）2；（c）4；（d）7；（e）6
Private Function fn3() As Boolean
opt = x(3)
Select Case opt
Case A
fn3 = (opt = x(1))
Case B
fn3 = (opt = x(2))
Case C
fn3 = (opt = x(4))
Case D
fn3 = (opt = x(7))
Case E
fn3 = (opt = x(6))
End Select
End Function
'4、答案是a的问题的个数是：
'（a）0；（b）1；（c）2；（d）3；（e）4
Private Function fn4() As Boolean
opt = x(4)
Dim i As Long
cntA = 0
For i = 1 To 10
If x(i) = A Then cntA = cntA + 1
Next
Select Case opt
Case A
fn4 = (cntA = 0)
Case B
fn4 = (cntA = 1)
Case C
fn4 = (cntA = 2)
Case D
fn4 = (cntA = 3)
Case E
fn4 = (cntA = 4)
End Select
End Function
'5、本问题答案和哪一个问题的答案相同？
'（a）10；（b）9；（c）8；（d）7；（e）6
Private Function fn5() As Boolean
opt = x(5)
Select Case opt
Case A
fn5 = (opt = x(10))
Case B
fn5 = (opt = x(9))
Case C
fn5 = (opt = x(8))
Case D
fn5 = (opt = x(7))
Case E
fn5 = (opt = x(6))
End Select
End Function
'6、答案是a的问题的个数和答案是什么的问题的个数相同？
'（a）b；（b）c；（c）d；（d）e；（e）以上都不是
Private Function fn6() As Boolean
opt = x(6)
Dim i As Long
Erase cnt
For i = 1 To 10
cnt(x(i)) = cnt(x(i)) + 1
Next
Select Case opt
Case A
fn6 = (cnt(A) = cnt(B))
Case B
fn6 = (cnt(A) = cnt(C))
Case C
fn6 = (cnt(A) = cnt(D))
Case D
fn6 = (cnt(A) = cnt(E))
Case E
fn6 = ((cnt(A) <> cnt(B)) And (cnt(A) <> cnt(C)) And (cnt(A) <> cnt(D)) And (cnt(A) <> cnt(E)))
End Select
End Function
'7、按照字母顺序，本问题的答案和下一个问题的答案相差几个字母？
'（a）4；（b）3；（c）2；（d）1；（e）0（注：a和b相差一个字母）
Private Function fn7() As Boolean
opt = x(7)
Dim tmp As Long
tmp = Abs(opt - x(8))
Select Case opt
Case A
fn7 = (tmp = 4)
Case B
fn7 = (tmp = 3)
Case C
fn7 = (tmp = 2)
Case D
fn7 = (tmp = 1)
Case E
fn7 = (tmp = 0)
End Select
End Function
'8、答案是元音字母(a,e)的问题的个数是：
'（a）2；（b）3；（c）4；（d）5；（e）6（注：a和e是元音字母）
Private Function fn8() As Boolean
opt = x(8)
Dim i As Long
cntY = 0
For i = 1 To 10
If (x(i) = A Or x(i) = E) Then cntY = cntY + 1
Next
Select Case opt
Case A
fn8 = (cntY = 2)
Case B
fn8 = (cntY = 3)
Case C
fn8 = (cntY = 4)
Case D
fn8 = (cntY = 5)
Case E
fn8 = (cntY = 6)
End Select
End Function
'9、答案是辅音字母(b,c,d)的问题的个数是：
'（a）一个质数；（b）一个阶乘数；（c）一个平方数；（d）一个立方数，（e）5的倍数
'（a）2,3,5,7 （b）1,2,6 （c）1,4,9 （d）1,8 （e）5,10
Private Function fn9() As Boolean
opt = x(9)
Dim i As Long
cntF = 0
For i = 1 To 10
If (x(i) = B Or x(i) = C Or x(i) = D) Then cntF = cntF + 1
Next
If cntF <> 0 Then
Select Case opt
Case A
fn9 = (cntF = 2 Or cntF = 3 Or cntF = 5 Or cntF = 7)
Case B
fn9 = (cntF = 1 Or cntF = 2 Or cntF = 6)
Case C
fn9 = (cntF = 1 Or cntF = 4 Or cntF = 9)
Case D
fn9 = (cntF = 1 Or cntF = 8)
Case E
fn9 = (cntF = 5 Or cntF = 10)
End Select
End If
End Function
'10、本问题的答案是：
'（a）a；（b）b；（c）c；（d）d；（e）e
Private Function fn10() As Boolean
opt = x(10)
Select Case opt
Case A
fn10 = (opt = A)
Case B
fn10 = (opt = B)
Case C
fn10 = (opt = C)
Case D
fn10 = (opt = D)
Case E
fn10 = (opt = E)
End Select
End Function
Private Sub Command1_Click()
Dim i As Long
Dim j1 As Long, j2 As Long, j3 As Long, j4 As Long, j5 As Long, j6 As Long, j7 As Long, j8 As Long, j9 As Long, j10 As Long
Dim tm As Single
tm = Timer
For j1 = 1 To 5
'x(1) <> B
If j1 <> B Then
x(1) = j1
For j2 = 1 To 5
x(2) = j2
For j3 = 1 To 5
x(3) = j3
'x(3) <> A <> B
If j3 <> A And j3 <> B Then
For j4 = 1 To 5
x(4) = j4
For j5 = 1 To 5
x(5) = j5
For j6 = 1 To 5
x(6) = j6
For j7 = 1 To 5
x(7) = j7
For j8 = 1 To 5
x(8) = j8
If (x(7) = A And x(8) = E) Or (x(7) = B And x(8) = E) Or (x(7) = C And (x(8) = A Or x(8) = E)) Or (x(7) = D And (x(8) = C Or x(8) = E)) Or (x(7) = E And x(8) = E) Then
For j9 = 1 To 5
x(9) = j9
If (x(8) = A And x(9) = D) Or (x(8) = B And x(9) = A) Or (x(8) = C And x(9) = B) Or (x(8) = D And x(9) = E) Or (x(8) = E And x(9) = C) Then
For j10 = 1 To 5
x(10) = j10
If fn1 Then
If fn2 Then
If fn3 Then
If fn4 Then
If fn5 Then
If fn6 Then
If fn7 Then
If fn8 Then
If fn9 Then
If fn10 Then
List1.AddItem "result found! time used: " & (Timer - tm) & "s"
Call ShowResult
Else
End If
Else
End If
Else
End If
Else
End If
Else
End If
Else
End If
Else
End If
Else
End If
Else
End If
Else
End If
Next j10
End If
Next j9
End If
Next j8
Next j7
Next j6
Next j5
Next j4
End If
Next j3
Next j2
End If
Next j1
List1.AddItem "search completed! time used: " & (Timer - tm) & "s"
End Sub
Sub ShowResult()
Dim s As String
Dim i As Long
For i = 1 To 10
s = s & abOptions(x(i))
Next
List1.AddItem s
End Sub
Private Sub Form_Load()
abOptions(A) = "A "
abOptions(B) = "B "
abOptions(C) = "C "
abOptions(D) = "D "
abOptions(E) = "E "
End Sub
转自http://blog.csdn.net/daisy8675/archive/2005/11/16/531172.aspx
