punter同志前不久提出了一个分组运算的问题，让Henry D. Sy 、ACMAIN.CHM 、t小雨 同志，以及我本人好生忙活了一阵。不过punter同志的问题似乎并没有得到完全解决。

　　究其原因，主要在于punter同志始终难以准确的描述问题。为了搞清楚punter同志的真正企图，一干人等采用了灌辣椒水，上老虎凳的办法。但是面对punter同志的坚贞不屈，严刑拷打也失去了效用。但是毕竟需要帮助punter同志解决问题，于是本人又对punter同志的数据进行了进一步分析，找到了punter同志的真正需求，punter同志所关心的第37条记录问题已经的到圆满解决。

　　恰好今天花了一上午琢磨ＡＤＯ问题，算是初步掌握了其中的奥秘。于是便以punter同志的实例，用数据集写了一个子程序。效果还不错，也算是在给自己和punter同志写一个教程，希望能对punter同志有用。


Private Sub 运算_Click()
Dim sql1 As String, sql2 As String
Dim rs As ADODB.Recordset                                               '定义一个ADO记录集
Dim x0 As Single, x1 As Single, x2 As Single, x3 As Single              '定义单精度变量，用于存放分组起点值、正最大峰值、负最大峰值、当前记录值
Dim y0 As Single, y1 As Single, y3 As Single                            '定义单精度变量，用于三个连续记录，以便趋势和峰值判断
Dim n0 As Long, n1 As Long                                              '定义长整型变量，用于存放分组起点序号和分组终点序号
If IsNull(Me.序号) Or IsNull(Me.比率) Then Exit Sub
Set rs = New ADODB.Recordset                                            '对rs赋值新实例
sql1 = "select * from data"
rs.Open sql1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic '打开记录集
DoCmd.SetWarnings False
sql = "DELETE * FROM data2;"                                            '清空data2
DoCmd.RunSQL sql
Me.data2.Form.Requery
rs.MoveFirst
rs.Find "序号=" & Me.序号, 0, adSearchForward, adBookmarkCurrent        '从当前位置开始向后搜索到与窗体序号相当的记录
Do While Not rs.EOF                                                     '循环分组运算
    　x0 = rs!数据                                                        '获得分组起点值
    　x1 = x0
    　x2 = x0
   　 n0 = rs!序号                                                        '获得分组起点序号
    　y0 = rs!数据                                                        '获得分组起点数据
    　Do While Not rs.EOF                                                 '循环运算分组终端点
       　　If Not rs.EOF Then
            　　rs.MoveNext                                                 '向下移动一个记录
            　　If Not rs.EOF Then
                　　　y1 = rs!数据
               　 　　n1 = rs!序号
            　　End If
       　 　Else
            　　　　Exit Do
        　　End If
        　　If Not rs.EOF Then
            　　　rs.MoveNext
            　　　If Not rs.EOF Then y2 = rs!数据
            　　　　　rs.MovePrevious                                              '向上移动一个记录
       　　 Else
            　　　Exit Do
        　　End If
        　　'以下进行分组终点判断
        　　If ((y0 > y1 And y1 < y2) Or (y0 < y1 And y1 > y2)) And Abs(y1 / x0 - 1) >= Me.比率 Then
             　　　Exit Do
        　　Else
            　　　If ((y0 > y1 And y1 < y2) Or (y0 < y1 And y1 > y2)) And Abs(y1 / x0 - 1) < Me.比率 Then
               　　　　 If y1 / x0 - 1 > 0 And y1 > x1 Then
                    　　　　　x1 = y1
                　　End If
               　　 If y1 / x0 - 1 < 0 And y1 < x1 Then
                    　　　　　x2 = y1
                　　End If
                　　If Abs(y1 / x2 - 1) >= Me.比率 Or Abs(y1 / x1 - 1) >= Me.比率 Then
                    　　　　　Exit Do
                　　End If
            　End If
       　 End If
    　　Loop
    　　'以下做追加查询
    　　sql = "INSERT INTO data2 ( 开始序号, 结束序号, 开始数据, 结束数据, 记录差数, 小计 ) "
    　　sql = sql + "SELECT First(序号) AS 开始序号, Last(序号) AS 结束序号, First(数据) AS 开始数据, Last(数据) AS 结束数据, [结束序号]-[开始序号] AS 记录差数, Sum([数据])-[开始数据] AS 小计 "
    　　sql = sql + "FROM data "
    　　sql = sql + "where 序号>=" & n0 & " and 序号<=" & n1 & ";"
    　　DoCmd.RunSQL sql
    　　Me.data2.Form.Requery
Loop
End Sub