execl vba一个统计数据的报表模块

概述execl vba一个统计数据的报表模块

下面是内存溢出 jb51.cc 通过网络收集整理的代码片段。

内存溢出小编现在分享给大家，也给大家做个参考。

Attribute VB_name = "reportcreate20130804"'All Rights Reserved Deserved by 蓝宝石的傻话Dim daq() As VariantDim dran()Dim tran()'定义函数统计每个数据表的情况Function data_q(msheet As Worksheet,dnum As Variant,tname As Variant,dcode As Variant,dstatus As Variant)dhead = Array("序号","管理类型码","单证名称","流水号","状态","机构代码")ReDim daq(UBound(dstatus),UBound(dnum))' 初始化二维数组数据为0For i = 0 To (UBound(dnum) - LBound(dnum))    For j = 0 To (UBound(dstatus) - LBound(dstatus))        daq(j,i) = 0    NextNext'定义表6统计每个数据包的报废流水号，首先定义列数r6 = 1For i = 0 To Sheet6.UsedRange.Columns.Count    If Len(Sheet6.Cells(1,r6)) <> 0 Then        r6 = r6 + 1    End IfNext'载入数据表并且选择当前数据表msheet.Select'如果数据表中第一列不是序号，则插入序号列If Cells(1,1).Value <> dhead(0) Then    Columns(1).Insert    Cells(1,1).Value = dhead(0)End IfReDim dran(UBound(dhead))For x = 1 To msheet.UsedRange.Columns.Count'统计选择的清单数据，第一步、把统计项目的对应列值整理出来    For i = 0 To (UBound(dhead) - LBound(dhead))        If InStr(Cells(1,x),dhead(i)) Then            dran(i) = x        End If    NextNext'统计清单上各项目的状态值For y = 2 To msheet.UsedRange.Rows.Count    msheet.Cells(y,dran(4)).NumberFormatLocal = "@"    msheet.Cells(y,dran(5)).NumberFormatLocal = "@"'需要统计的项目    For b = 0 To (UBound(dnum) - LBound(dnum))'需要统计的状态        For a = 0 To (UBound(dstatus) - LBound(dstatus))            If InStr(msheet.Cells(y,dran(1)),dnum(b)) And (msheet.Cells(y,dran(4)).Value = dstatus(a) Or msheet.Cells(y,dran(4)).Value = dcode(a)) Then'统计每个项目每个状态的数量，并填入序号                daq(a,b) = daq(a,b) + 1                Cells(y,1).Value = daq(a,b)'针对统计的项目在表6中生成对应的列                Sheet6.Cells(1,r6 + b).Value = tname(b)'统计作废的流水号并填入表6                If InStr(msheet.Cells(y,dran(4)),"作废") Or msheet.Cells(y,dran(4)).Value = dcode(2) Or msheet.Cells(y,dran(4)).Value = dcode(3) Or msheet.Cells(y,dran(4)).Value = dcode(8) Then                    Sheet6.Cells(2,r6 + b).Value = daq(2,b) + daq(3,b) + daq(8,b)                    Sheet6.Cells(daq(a,b) + 2,r6 + b).NumberFormatLocal = "@"                    Sheet6.Cells(daq(a,r6 + b).Value = msheet.Cells(y,dran(3)).Value                End If            End If        Next    NextNextEnd Function'统计报表1的数据写入Function data_write(tname As Variant)'留作自动化报表使用（未编写）'thead = Array("（1）月初库存","（2）当月领用","（3）正常使用","（4）作废","（5）遗失","（7）月末实物库存")Sheet1.Select'将清单一的数据统计人工回收和系统回收相加，人工作废和作废相加后的数据写入报表For y = 1 To Sheet1.UsedRange.Rows.Count    For i = 0 To (UBound(tname) - LBound(tname))        If Cells(y,1).Value = tname(i) Then            Sheet1.Cells(y,2) = Sheet1.Cells(y,10)            Sheet1.Cells(y,4).Value = daq(0,i) + daq(1,i) + daq(6,i) + daq(7,i)            Sheet1.Cells(y,5).Value = daq(2,i) + daq(3,i) + daq(8,6).Value = daq(4,i) + daq(5,i)        End If    NextNextEnd FunctionFunction data2_write(dnum As Variant,dstatus As Variant)thead = Array("管理类型码","版本号","数量","状态")Sheet2.Select'统计清单一数据第一步，把统计项目的对应列值扫出来ReDim tran(UBound(thead))For x = 1 To Sheet2.UsedRange.Columns.Count    For i = 0 To (UBound(thead) - LBound(thead))        If InStr(Cells(1,thead(i)) Then            tran(i) = x        End If    NextNext'定义表2统计每个数据包的报废流水号，首先定义列数r2 = 1For i = 1 To Sheet2.UsedRange.Rows.Count        r2 = iNextMsgBox r2'将数据表统计出来的状态分类填写'MsgBox UBound(dnum)For i = 0 To (UBound(dnum) - LBound(dnum))    For j = 0 To (UBound(dstatus) - LBound(dstatus))            If InStr(tname(i),"外包") = 0 Then            For y = 1 To Sheet2.UsedRange.Rows.Count                If Sheet2.Cells(y,tran(0)).Value = dnum(i) And Sheet2.Cells(y,tran(4)).Value = dstatus(j) Then                    Sheet2.Cells(y,tran(3)).Value = daq(j,i)                End If            Next        ElseIf daq(j,i) <> 0 And InStr(tname(i),"外包") Then'        MsgBox InStr(tname(i),"外包")            r2 = r2 + 1            Sheet2.Cells(r2 + i,tran(0)).Value = dnum(i)            Sheet2.Cells(r2 + i,tran(1)).Value = tname(i)            Sheet2.Cells(r2 + i,tran(2)).NumberFormatLocal = "@"            Sheet2.Cells(r2 + i,tran(2)).Value = "0000"            Sheet2.Cells(r2 + i,i)            Sheet2.Cells(r2 + i,tran(4)).Value = dstatus(j)        End If    NextNextEnd FunctionSub report_create()'0-未知;1-待入库;2-库存;3-未使用;4-人工回收;5-系统回收'6-作废;7-系统作废;8-过期;9-超期登报遗失;10-挂失;11-遗失'12-停用;13-预期废止;14-废止;15-系统删除;16-系统回收未激活;17-系统回收激活'18-打印;19-中介发放未激活;20-未入库;22-过期作废dcode = Array("4","5","6","7","9","11","16","17","22")dstatus = Array("人工回收","系统回收","作废","系统作废","超期登报遗失","遗失","系统回收未激活","系统回收激活","过期作废")dnum = Array("CN011","FN20001","PN011","PN031","YE001A","YE012(8623)")dnum1 = Array("FN20001")tname = Array("理赔批单三联","广东机打发票","小批单","团体保全人名清单（小）","保单一联","批单三联")tname1 = Array("广东机打发票（外包出单中心）")tname2 = Array("广东机打发票（邮政外包中心）")Sheet6.UsedRange.Clear'报表数据填入3、4、5项Call data_q(Sheet3,dnum,tname,dcode,dstatus)Call data_write(tname)Call data2_write(dnum,dstatus)Call data_q(Sheet4,dnum1,tname1,dstatus)Call data_write(tname1)Call data2_write(dnum1,dstatus)Call data_q(Sheet5,tname2,dstatus)Call data_write(tname2)Call data2_write(dnum1,dstatus)Sheet2.SelectEnd Sub

以上是内存溢出(jb51.cc)为你收集整理的全部代码内容，希望文章能够帮你解决所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。

总结

以上是内存溢出为你收集整理的execl vba一个统计数据的报表模块全部内容，希望文章能够帮你解决execl vba一个统计数据的报表模块所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。