一道经典的数学推理题！
有12个外观一模一样的小球，其中11个质量是相等的，有且只有1个和其他11个质量不一样。现在给你一台天平，只许你称3次，你怎样把质量不一样的那个小球找出来？？？ 
男人的謊言可以騙女人的壹夜！ 女人的謊言可以騙男人的壹生！
Option Explicit
Private Sub Form_Load()
Dim a(11) As Long
Dim i As Long, b As Long, Result As Long
10:
Randomize
'正品的重量为5,次品为6或4
For i = 0 To 11
a(i) = 5
Next
b = Rnd * 11
a(b) = IIf(Rnd * 3 > 2, 6, 4)
Dim c1&, c2&, c3& '分别为第一次,第二次,第三次的比较结果
c1 = Cmp(a(0) + a(1) + a(2) + a(3), a(4) + a(5) + a(6) + a(7))
If c1 = 0 Then
'在8,9,10,11(这时0-7是好的)
c2 = Cmp(a(8), a(10))
If c2 = 0 Then
'8和10相等,则表示在 9 或 11
c3 = Cmp(a(9), a(0))
If c3 = 0 Then
Result = 11
Else
Result = 9
End If
Else '在8 或 10
c3 = Cmp(a(8), a(0))
If c3 = 0 Then
Result = 10
Else
Result = 8
End If
End If
Else
'在0,1,2,3,4,5,6,7
c2 = Cmp(a(0) + a(5) + a(6) + a(7), a(4) + a(8) + a(9) + a(10))
If c2 = 0 Then
'在1,2,3
c3 = Cmp(a(1), a(2))
If c3 = 0 Then
'如果1和2相等,则表示第3个球是有问题的
Result = 3
ElseIf (c3 = c1) Then
'好好想一下,我都不知如何表达是好....
Result = 1
Else
Result = 2
End If
ElseIf c2 <> c1 Then
'由于移动了5,6,7,而8,9,10是好的,所以得出坏球在 5,6,7
c3 = Cmp(a(5), a(6))
If c3 = 0 Then
Result = 7
ElseIf c3 = c1 Then
'5,6,7一开始是在右边的,这里与1,2,3稍有不同
Result = 6
Else
Result = 5
End If
Else
'在0,4
c3 = Cmp(a(0), a(8))
If c3 = 0 Then
Result = 4
Else
Result = 0
End If
End If
End If
Dim s As String
s = "次品:" & b & vbCrLf
s = s & "结果:" & Result & vbCrLf & vbCrLf
s = s & "清单:" & vbCrLf
For i = 0 To 11
s = s & Format(i, "(00)") & a(i) & vbCrLf
Next
s = s & "要继续吗?"
If MsgBox(s, vbYesNo + vbInformation) = vbYes Then
GoTo 10
End If
Unload Me
End Sub
'--------------------------------------------------------------
'Cmp函数当作一把天平,如果左边重返回1,右边重返回-1,相等返回0
Private Function Cmp(ByVal a As Long, ByVal b As Long) As Long
If a > b Then
Cmp = 1
ElseIf a < b Then
Cmp = -1
Else
Cmp = 0
End If
End Function
