用数组碰到问题

付谦

见附件，请帮助

付谦

“组别”字段无关紧要，测试二 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

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

付谦

问题完全解决

Private Sub Command29_Click()
      CurrentDb.Execute "UPDATE 报表数据源表 SET 报表数据源表.印页 = 0;"
      Dim i, i3 As Integer
      Dim n As Integer
      Dim Intsz() As Integer
      Dim strsql As String
      Dim rst As Object
      Dim ww, qq, 组别 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 s, v, f As Integer
          Dim x, 加组 As Integer
          ssql6 = "select 世代,页,印页,转下页行 from 报表数据源表 ORDER BY 世代,页,页序 "
          rs6.Open ssql6, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
          rs6.MoveFirst
            加页 = 0
     For I2 = 1 To CLng(rs6.RecordCount)
              ww = rs6!世代
              s = rs6!页
              v = rs6!转下页行
              f = Int((ww - 1) / qq)       '分组
        If f = 组别 Then                   '同组
           rs6!印页 = s + sum
           If f > 0 And s = Intsz(f + 1) And v > 0 Then
               Intsz(f) = Intsz(f) + 1        '加页赋值给数组     '
           Else
            '  Intsz(f) = Intsz(f)             '不加页不变
           End If
        Else                       '下一组的第一条
           sum = 0
              组别 = Int((ww - 1) / qq)
           For x = 1 To f
               sum = sum + Intsz(x)       '前面组累加数
           Next
        End If
           rs6!印页 = s + sum
                rs6.Update
                rs6.MoveNext
     Next I2
           rst.Close
           Set rst = Nothing
           rs6.Close
           Set rs6 = Nothing
End Sub

付谦

付谦 发表于 2022-6-11 17:48
问题完全解决

Private Sub Command29_Click()

加页=0    加组 多余

付谦

我用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

压缩包上传附件吧

付谦

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

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

付谦

roych

是否一定要用VBA呢？其实也不一定的。拆解下来，重新设计数据表，也可以使用查询来处理。

按六代分组，每组的最大页存入数组 Intsz（结果同查询5）。每条记录的印页在本人页的基础上加上组的最大页

——使用max建立一个分组查询。再以这个分组查询，使用DSUM根据组别累计。

如果每组最大页有转下页行还要多加一页

——使用IIF函数处理。
至此，基本逻辑理清。接下来处理表和查询。

• 在原表基础上添加“组别”字段。
• 根据组别新建分组查询，得到每组的最大页数。
• 根据2的结果使用DSUM作为累计。
• 新建一个页数累计数据表，可设置组别为主键。把3的结果追加上去。为了避免重复追加，可以创建一个删除查询。
• 将4的结果和数据源关联，创建查询更新“印页”字段。
• 创建宏，把上述的操作查询添加进来，供后续按钮调用。
  

具体请参考附件。

大多数复杂的逻辑，都是因为表设计不规范所致。至于分组为7、8或者其它值，使用ADO更新“组别”字段即可。

付谦

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

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

roych

付谦 发表于 2022-6-7 21:23
roych:
   感谢你的帮助！我认为不用vba，这件事反而复杂。测试二代码能够解决分组与组别累计，除组最大 ...

累计这个没得解。写循环呗，累计所有不大于该组别的数据。
但问题是，本身你是没有“组别”这个字段的。如何判断何时达到这个组别，是个问题。
如果非要用VBA，数组估计不是那么方便，不妨考虑下字典。