数学题 [复制链接]

[em14][em14][em14][em14]

按规律最后那个数应为1992

上午匆忙看题，没细想，回答错误。仔细想想这题还蛮复杂，但有规律可循。借Excel平台用VBA编一小段程序，运行结果最后剩下的一个数是1598，有兴趣者不妨一试，程序如下：

Dim a(1993) As Integer
Dim b(1993) As Integer
Dim c(1993) As Integer
Dim i, j, k, x As Integer
Dim BLineCount As Range

For i = 1 To 1993
a(i) = ActiveSheet.Cells(i, 1).Value
Next i
For j = 1 To 1993 Step 3
b(j) = a(j)
Sheets(1).Cells(j, 1).Value = ""
Next j
Set BLineCount = Worksheets(1).Range("A:A")
x = Application.WorksheetFunction.Count(BLineCount)

Do
Do
For i = 1 To 1993
    If ActiveSheet.Cells(i, 1).Value <> "" And ActiveSheet.Cells(i, 1).Value <> 0 Then
    k = k + 1
    c(k) = ActiveSheet.Cells(i, 1).Value
    Else
    End If
Next i
Loop Until k = x
Worksheets(1).Range("A:A").Delete

For i = 1 To k
ActiveSheet.Cells(i, 1).Value = c(i)
Next i

For i = 1 To k Step 3
Sheets(1).Cells(i, 1).Value = ""
Next i
Set BLineCount = Worksheets(1).Range("A:A")
x = Application.WorksheetFunction.Count(BLineCount)
k = 0
Loop Until x = 1

按以下修改后程序运行，可求得任意整数（N）按题意循环后剩下的最后一个数（Y）。如N=1000 ，Y=710；N=2000，Y=1598；N=3000，Y=2397。。。。。一定域范围的N，求得的Y相等。

Sub AA(ByVal N As Integer)
Dim a() As Integer '将N换成任何数，按题的规律都可求得最后剩下的那个数。
Dim c() As Integer
Dim i, j, k, x As Integer
Dim BLineCount As Range
ReDim a(N) As Integer '将N换成任何数，按题的规律都可求得最后剩下的那个数。
ReDim c(N) As Integer

For i = 1 To N '1-N放入数组
a(i) = i
ActiveSheet.Cells(i, 1).Value = a(i)
Next i
For j = 1 To N Step 3 '按规律清除
Sheets(1).Cells(j, 1).Value = ""
Next j
Set BLineCount = Worksheets(1).Range("A:A")
x = Application.WorksheetFunction.Count(BLineCount) '剩多少个数
Do
For i = 1 To N
    If ActiveSheet.Cells(i, 1).Value <> "" And ActiveSheet.Cells(i, 1).Value <> 0 Then
    k = k + 1
    c(k) = ActiveSheet.Cells(i, 1).Value
    Else
    End If
Next i
Worksheets(1).Range("A:A").Delete

For i = 1 To k
ActiveSheet.Cells(i, 1).Value = c(i)
Next i

For i = 1 To k Step 3
Sheets(1).Cells(i, 1).Value = ""
Next i
Set BLineCount = Worksheets(1).Range("A:A")
x = Application.WorksheetFunction.Count(BLineCount) '剩多少个数
k = 0
Loop Until x = 1

运行以下程序速度更快，因为代码更简单。

Dim a() As Integer
Dim i, j As Integer
Dim ALineCount As Range
ReDim a(N) As Integer

For i = 1 To N
a(i) = i
ActiveSheet.Cells(i, 1).Value = a(i)
Next i

Do
For j = 1 To N Step 3
Sheets(1).Cells(j, 1).Value = ""
Next j
    Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin, DataOption1:=xlSortNormal
Set ALineCount = Worksheets(1).Range("A:A")
N = Application.WorksheetFunction.Count(ALineCount)
Loop Until N = 1

举几个简单例子，朋友们可验证一下。N=20,Y=18;N=25,Y=18;N=30,Y=27;N=36,Y=27;N=50,Y=41;N=61,Y=61......一定域范围的N，求得的Y相等。

正是高手！！！！！！1