专家坐堂-[求助]号码段分组统计Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  [求助]号码段分组统计  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=11536)

--  作者：hzcaqjf
--  发布时间：2011/8/1 21:12:00
--  [求助]号码段分组统计

"表A"的"起号"有的是跟上一行"止号"连续的,有的是不连续的.

统计要求是(如"表B"):

1,根据"表A"中连续的起止号段形成一个分组行,共得到三个分组行.

2,根据各分组行统计出所属"单证状态"的总张数

3,根据各分组行统计出所属"退单、废单"的总张数.

4,根据各分组行统计出所属"售单"的保费总金额.

求代码,给个提示也行.

下载信息  [文件大小：   下载次数： ]
点击浏览该文件:统计.rar

[此贴子已经被作者于2011-8-1 21:20:32编辑过]

--  作者：狐狸爸爸
--  发布时间：2011/8/1 21:48:00
--

手工编码统计算了：

http://www.foxtable.net/help/topics/0681.htm

--  作者：mr725
--  发布时间：2011/8/2 8:59:00
--

放在项目 maintablechanged 事件中：（你自己优化吧）

DataTables("表B").datarows.clear()
Dim n As Integer
For i As Integer = 0 To Tables("表A").count-1
    If i = 0
        Tables("表B").addnew()
        Tables("表B").Rows(n)("起号") = Tables("表A").Rows(i)("起号")
        Tables("表B").Rows(n)("序号") = n+1
        n = n + 1
    Else
        If i = Tables("表A").count-1
            Tables("表B").addnew()
            Tables("表B").Rows(n-1)("止号") = Tables("表A").Rows(i)("止号")
            Tables("表B").Rows(n-1)("全部单证张数") = Tables("表A").Compute("Sum(张数)","起号 >= \'" & _
            Tables("表B").Rows(n-1)("起号") & "\' and 起号 <= \'" & Tables("表A").Rows(i)("起号") & "\' ")
            Tables("表B").Rows(n-1)("售单张数") = Tables("表A").Compute("Sum(张数)","单证状态 = \'售单\' and 起号 >= \'" & _
            Tables("表B").Rows(n-1)("起号") & "\' and 起号 <= \'" & Tables("表A").Rows(i)("起号") & "\' ")
            Tables("表B").Rows(n-1)("退废单张数") = Tables("表A").Compute("Sum(张数)","(单证状态 = \'退单\' or 单证状态 = \'废单\') and 起号 >= \'" & _
            Tables("表B").Rows(n-1)("起号") & "\' and 起号 < \'" & Tables("表A").Rows(i)("起号") & "\' ")
            Tables("表B").Rows(n-1)("售单金额") = Tables("表A").Compute("Sum(保费)","单证状态 = \'售单\' and 起号 >= \'" & _
            Tables("表B").Rows(n-1)("起号") & "\' and 起号 <= \'" & Tables("表A").Rows(i)("起号") & "\' ")
            Tables("表B").Rows(n)("序号") = "合计"
            Tables("表B").Rows(n)("全部单证张数") = Tables("表B").Compute("Sum(全部单证张数)")
            Tables("表B").Rows(n)("售单张数") = Tables("表B").Compute("Sum(售单张数)")
            Tables("表B").Rows(n)("退废单张数") = Tables("表B").Compute("Sum(退废单张数)")
            Tables("表B").Rows(n)("售单金额") = Tables("表B").Compute("Sum(售单金额)")
        Else
            If val(Tables("表A").Rows(i)("起号")) - val(Tables("表A").Rows(i-1)("止号")) > 1
                Tables("表B").addnew()
                Tables("表B").Rows(n-1)("止号") = Tables("表A").Rows(i-1)("止号")
                Tables("表B").Rows(n)("起号") = Tables("表A").Rows(i)("起号")
                Tables("表B").Rows(n-1)("全部单证张数") = Tables("表A").Compute("Sum(张数)","起号 >= \'" & _
                Tables("表B").Rows(n-1)("起号") & "\' and 起号 < \'" & Tables("表B").Rows(n)("起号") & "\' ")
                Tables("表B").Rows(n-1)("售单张数") = Tables("表A").Compute("Sum(张数)","单证状态 = \'售单\' and 起号 >= \'" & _
                Tables("表B").Rows(n-1)("起号") & "\' and 起号 < \'" & Tables("表B").Rows(n)("起号") & "\' ")
                Tables("表B").Rows(n-1)("退废单张数") = Tables("表A").Compute("Sum(张数)","(单证状态 = \'退单\' or 单证状态 = \'废单\') and 起号 >= \'" & _
                Tables("表B").Rows(n-1)("起号") & "\' and 起号 < \'" & Tables("表B").Rows(n)("起号") & "\' ")
                Tables("表B").Rows(n-1)("售单金额") = Tables("表A").Compute("Sum(保费)","单证状态 = \'售单\' and 起号 >= \'" & _
                Tables("表B").Rows(n-1)("起号") & "\' and 起号 < \'" & Tables("表B").Rows(n)("起号") & "\' ")
                Tables("表B").Rows(n)("序号") = n+1
                n = n + 1
            End If
        End If
    End If
Next

--  作者：hzcaqjf
--  发布时间：2011/8/2 10:30:00
--

已经收藏,再慢慢参悟学习.感谢狐爸的提示和"mr725"老师的帮助.

--  作者：hhbb
--  发布时间：2011/8/2 15:45:00
--

Dim zd As new Dictionary(of DataRow,DataRow)
Dim dr,dr1,dr2 As DataRow
Dim t1,t2 As Table
Dim n As Integer
Dim s As String
t1 = Tables("表A")
t2 = Tables("表B")
For Each dr In t1.DataTable.DataRows
   s="起号 Like \'" & dr("起号").Substring(0,1) & "*\'"
   dr1= t1.DataTable.Find(s)
   dr2= t1.DataTable.Find(s,"起号 Desc")
   If dr("起号") = dr1("起号") Then
   zd.Add(dr1,dr2)
   End If
Next
t2.StopRedraw
t2.DataTable.DataRows.clear
t2.AddNew(zd.keys.count)

For Each dr In zd.Keys
   t2.Rows(n)("序号") = n+1
   t2.Rows(n)("起号")=dr("起号")
   n+ =1
Next
n=0
For Each dr In zd.values
   t2.Rows(n)("止号")=dr("止号")
   n+ =1
Next

For Each dr In t2.DataTable.DataRows
   s =" and 起号 >=\'" & dr("起号") & "\'and 止号 <= \'" & dr("止号") & "\'"
   dr("全部单证张数")= dr("止号")- dr("起号") +1
   dr("售单张数")=t1.DataTable.Compute("Sum(张数)","单证状态 = \'售单\'" & s)
   dr("退废单张数")=t1.DataTable.Compute("Sum(张数)","单证状态 In(\'退单\',\'废单\')" & s)
   dr("售单金额")=t1.DataTable.Compute("Sum(保费)","单证状态 = \'售单\'" & s)
Next

Dim g As Subtotalgroup
t2.SubtotalGroups.Clear()
t2.GroupAboveData = False
t2.TreeVisible = False
t2.SpillNode = True

g = New Subtotalgroup
g.Aggregate = AggregateEnum.Sum
g.GroupOn = "*"
g.TotalOn = "全部单证张数,售单张数,退废单张数,售单金额"
g.Caption = "合计"
t2.SubtotalGroups.Add(g)

t2.Subtotal()
t2.ResumeRedraw

--  作者：hzcaqjf
--  发布时间：2011/8/2 16:26:00
--

"hhbb"您好!

s="起号 Like \'" & dr("起号").Substring(0,1) & "*\'"

这段代码的意思不大明白,能否说明一下?

--  作者：hhbb
--  发布时间：2011/8/2 16:54:00
--

如:"起号 Like \'1*\'",以"1"开头; "起号 Like \'2*\'",以"2"开头....

--  作者：mr725
--  发布时间：2011/8/2 17:35:00
--

以下是引用hzcaqjf在2011-8-2 16:26:00的发言：

"hhbb"您好!

s="起号 Like \'" & dr("起号").Substring(0,1) & "*\'"

这段代码的意思不大明白,能否说明一下?

起号包含起号的第一个字符

--  作者：hhbb
--  发布时间：2011/8/2 23:48:00
--

再来一个高效点的:

Dim n,s1,s2,s3,s4 As Double
Dim sql As String
Dim t = Tables("表B")
Dim r As Row
sql+ = "select 序号,Min(起号) as 起号,Max(止号) as 止号,"
sql+ = "sum(张数) as 全部单证张数,sum(a1) as 售单张数,"
sql+ = "sum(a2) as 退废单张数,sum(a3) as 售单金额 "
sql+ = "from(select Len(起号) & Left(起号,1) as 序号,"
sql+ = "起号,止号,张数,iif(单证状态 =\'售单\',张数,null) as a1,"
sql+ = "iif(单证状态 In(\'退单\',\'废单\'),张数,null) as a2,"
sql+ = "iif(单证状态 =\'售单\',保费,null) as a3 from{表A} "
sql+ = "where 起号 >\'\') group by 序号 order by 序号"

t.DataTable.Fill(sql,True)

For Each r In t.Rows
   r("序号") = n+1
   s1+=r("全部单证张数")
   s2+ = r("售单张数")
   s3+= r("退废单张数")
   s4+ = r("售单金额")
   n+ = 1
Next
r=t.addnew
r("序号") = "合计"
r("全部单证张数") = s1
r("售单张数") = s2
r("退废单张数") = s3
r("售单金额") = s4

[此贴子已经被作者于2011-8-3 13:06:11编辑过]

--  作者：狐狸爸爸
--  发布时间：2011/8/3 8:03:00
--
牛