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

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

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

n=0

For Each dr In zd.values

t2.Rows(n)("止号")=dr("止号")

n+ =1

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)

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

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

再来一个高效点的:

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

r=t.addnew

r("序号") = "合计"

r("全部单证张数") = s1

r("售单张数") = s2

r("退废单张数") = s3

r("售单金额") = s4

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

[+]---叠加,[as]---重新命名

用窗口表试试:

Dim n,s1,s2,s3,s4 As Double

Dim sql As String

Dim t = Tables("窗口1_Table1")

Dim r As Row

sql = "select * from(select Len(起号) & Left(起号,1) as 序号,起号,止号,张数 as 全部单证张数,iif(单证状态 ='售单',张数,null) as 售单张数,iif(单证状态 In('退单','废单'),张数,null) as 退废单张数,iif(单证状态 ='售单',保费,null) as 售单金额 from{表A} where 起号 >'' ) order by 序号 ,起号"

t.Fill(sql,True)

For n = 0 To T.Rows.count-1

If n = 0 Then

T.Rows(n)("序号") =T.Rows(n)("序号") & "-0"

ElseIf Val(T.Rows(n)("起号")) = Val(T.Rows(n-1)("止号"))+1 Then

T.Rows(n)("序号") =T.Rows(n-1)("序号")

Else

T.Rows(n)("序号") =T.Rows(n)("序号") & "-" & n

End If

Dim b As New GroupTableBuilder("统计表1",DataTables("窗口1_Table1"))

b.Groups.AddDef("序号")

b.Totals.AddDef("起号",AggregateEnum.Min)

b.Totals.AddDef("止号",AggregateEnum.Max)

b.Totals.AddDef("全部单证张数")

b.Totals.AddDef("售单张数")

b.Totals.AddDef("退废单张数")

b.Totals.AddDef("售单金额")

t.DataSource = b.BuildDataSource()

n =0

For Each r In t.Rows

r("序号") = n+1

If r("退废单张数") = 0 Then

r("退废单张数") =Nothing

End If

s1+=r("全部单证张数")

s2+ = r("售单张数")

s3+= r("退废单张数")

s4+ = r("售单金额")

n+ = 1

r=t.addnew

r("序号") = "合计"

r("全部单证张数") = s1

r("售单张数") = s2

r("退废单张数") = s3

r("售单金额") = s4

t.AutoSizeCols

原文件中數據輸入有點不對所至:

82行:0006 2197808-2197825 售单

83行:0007 2197809-2197809 退单

此主题相关图片如下：000.gif

[此贴子已经被作者于2011-8-6 19:47:37编辑过]

主题：[求助]号码段分组统计