50枚棋子围成圆圈,编上号码1,2,3……50,每隔一枚棋子取出一枚,要求最后留下的棋子号码为42号.

代码比较长,但是思路比较容易理解.也没用巧方法,就是用程序去穷举.
思路:让程序判断,从第一个开始拿,最后剩下的是哪个,直到找出从第几个开始拿,最后可以剩下42为止.
最后输出拿的顺序..以便于检验是否正确...以下代码运行的结果是
---------------------------
工程1
---------------------------
从第 7 个开始拿,最后剩下的是 42
拿的顺序是:7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,1,3,5,8,12,16,20,24,28,32,36,40,44,48,2,6,14,22,30,38,46,4,18,34,50,26,10,
---------------------------
确定
---------------------------
Option Explicit
Dim C(1 To 50) As Byte '定义数组,下标1-50一共50个C(1)=0 代表存在 C(1)=1 代表取出
Dim PickOut As New Collection '存储取出Id的顺序
Private Sub Command1_Click()
Dim i As Long
Dim theOne As Integer
For i = 1 To 50
If GetLastNum(i) = 42 Then'如果从第i个拿,剩下的是42,就记录这个i并跳出循环
theOne = i
Exit For
End If
Next
Dim strOut As String
strOut = "从第 " & theOne & " 个开始拿,最后剩下的是 42" & vbCrLf & "拿的顺序是:"

For i = 1 To PickOut.Count
strOut = strOut & PickOut.Item(i) & ","
Next

MsgBox strOut
End Sub
'传入从第几个开始,返回最后剩下哪个
Private Function GetLastNum(ByVal StartNum As Integer) As Integer
Dim i As Long
Dim RemainCount As Long '记录剩余数量
Dim iPos As Integer
'重置数据
For i = 1 To 50
C(i) = 0
Next
RemainCount = 50
For i = 1 To PickOut.Count
PickOut.Remove 1
Next
i = 0
iPos = StartNum
C(iPos) = 1 '将开始的第一个标记拿出
RemainCount = RemainCount - 1 '总数减一
PickOut.Add iPos
Do While RemainCount > 1
'找出下一个可以拿的ID
iPos = GetNextPickNum(iPos)
If iPos = 49 Then
iPos = iPos
End If
C(iPos) = 1 '标记拿出
RemainCount = RemainCount - 1 '总数减一
PickOut.Add iPos
Loop
For i = 1 To 50
If C(i) = 0 Then
GetLastNum = i
Exit Function
End If
Next
End Function
'从当前棋子开始,找出可以拿出的下个棋子
Private Function GetNextPickNum(ByVal Index As Integer) As Integer
Dim i As Integer
Dim PassCount As Integer '需要间隔的棋子个数
Dim NowID As Integer
For i = 1 To 50
NowID = Index + i
'超过50,从1号开始
If NowID > 50 Then NowID = NowID - 50
If PassCount = 1 And C(NowID) = 0 Then '如果已经间隔一个了,就返回
GetNextPickNum = NowID
Exit Function
End If
If C(NowID) = 0 Then
PassCount = PassCount + 1
End If
Next
End Function