用数组碰到问题

付谦

见附件，请帮助

付谦

我用winrar压缩了上传附件,就是上传不了,请版主给我解?决一下,问题出在何处?

付谦

按六代分组，每组的最大页存入数组 Intsz（结果同查询5）。每条记录的印页在本人页的基础上加上组的最大页，如第一组（1-6世)的印页=页+0,即不变.第二组（7-12世)的印页=页+上组的最大页3,第三组（13-18世)的印页=页+前二组的最大页和,即3+8=11.第四组（19-24世)的印页=页+前三组的最大页和,即3+8+67=78.以此类推.....如果每组最大页有转下页行还要多加一页。我写的代码存在2个问题，一是第6世本为第一组，印页=页，可第6世加了本组的最大页3，2是有转下页行的多加一页没有加页。请帮助。

Private Sub Command25_Click()
      CurrentDb.Execute "UPDATE 报表数据源表 SET 报表数据源表.印页 = 0;"
      Dim I As Integer
      Dim n As Integer
      Dim Intsz() As Integer
      Dim strsql As String
      Dim rst As Object
     Dim nn, ww, qq, ttt As Long
     nh = 6
      qq = nh
      strsql = "SELECT Max(报表数据源表.页) AS 页之最大值 FROM 报表数据源表 GROUP BY Partition([世代],1,100," & qq & " ) HAVING (((Partition([世代], 1, 100," & qq & " )) <> False)) ORDER BY Partition([世代],1,100," & qq & ");"
      Set rst = CurrentDb.OpenRecordset(strsql)
       rst.MoveLast
       rst.MoveFirst
         n = rst.RecordCount
      ReDim Intsz(1 To n)
      For I = 1 To n
        Intsz(I) = rst("页之最大值")
      rst.MoveNext
      Next I
          Dim rs6 As New ADODB.Recordset
          Dim I2 As Long
          Dim ssql6 As String
          Dim kk1, s, v, f, kp As Integer
           Dim j As Integer         
          ssql6 = "select 世代,页,印页,转下页行 from 报表数据源表 ORDER BY 世代,页 "
          rs6.Open ssql6, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
          rs6.MoveLast
          rs6.MoveFirst
       For I2 = 1 To CLng(rs6.RecordCount)
              ww = rs6!世代
              s = rs6!页
              v = rs6!转下页行
              f = Int(ww / 6)
           If f = 0 Then
              kk1 = 0
           Else
              If s = Intsz(f) And v > 0 Then
                 j = 1
             Else
                 j = 0
             End If
             kk1 = Intsz(f) + j            
          End If
              f = f + 1            
              rs6!印页 = s + kk1      
              rs6.Update        
               rs6.MoveNext
        Next I2
           rst.Close
           Set rst = Nothing
           rs6.Close
           Set rs6 = Nothing
End Sub

付谦

第一个问题已经解决, f = Int(ww / 6)改成f = Int((ww-1) / 6，还有前最大页累加和最大页有转行的增页问题，请帮助

付谦

roych 发表于 2022-6-6 13:34
压缩包上传附件吧

我用winrar压缩了上传附件,就是上传不了,请版主给我解?决一下,问题出在何处?

付谦

付谦

roych 发表于 2022-6-7 13:34
是否一定要用VBA呢？其实也不一定的。拆解下来，重新设计数据表，也可以使用查询来处理。——使用max建立一 ...

roych:
   感谢你的帮助！我认为不用vba，这件事反而复杂。测试二代码能够解决分组与组别累计，除组最大页有转页的没有加一页外，其他结果也是对的，只是采用+号，如果分组多+号更多，没有体现利用其规律性提高通用性。
    请大家继续帮助

付谦

“组别”字段无关紧要，测试二 f = Int((ww - 1) / 6)语句就是分组用的,0为第一组,1为第二组,2为第三组,类推分组最大页累加可用循环解决 For i = 1 To f        'f是组别
                                        sum = sum + Intsz(i)
                                         Next
下面这段 也可用循环解决
       If f = 0 Then
              kk1 = 0
           ElseIf f = 1 Then
               kk1 = Intsz(1)
           ElseIf f = 2 Then
               kk1 = Intsz(1) + Intsz(2)
           ElseIf f = 3 Then
               kk1 = Intsz(1) + Intsz(2) + Intsz(3)
           ElseIf f = 4 Then
               kk1 = Intsz(1) + Intsz(2) + Intsz(3) + Intsz(4)
         End If

现困扰我的是如何组合和加页的问题,

付谦

现困扰我的是如何组合和加页的问题,

付谦

“组别”字段无关紧要