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

以下代码由PHP站长网 52php.cn收集自互联网

现在PHP站长网小编把它分享给大家，仅供参考

Attribute VB_Name = "reportcreate20130804"
'All Rights Reserved Deserved by 蓝宝石的傻话

Dim daq() As Variant
Dim 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))
' 初始化二维数组数据为0
For i = 0 To (UBound(dnum) - LBound(dnum))
    For j = 0 To (UBound(dstatus) - LBound(dstatus))
        daq(j,i) = 0
    Next
Next
'定义表6统计每个数据包的报废流水号，首先定义列数
r6 = 1
For i = 0 To Sheet6.UsedRange.Columns.Count
    If Len(Sheet6.Cells(1,r6)) <> 0 Then
        r6 = r6 + 1
    End If
Next
'载入数据表并且选择当前数据表
msheet.Select
'如果数据表中第一列不是序号，则插入序号列
If Cells(1,1).Value <> dhead(0) Then
    Columns(1).Insert
    Cells(1,1).Value = dhead(0)
End If
ReDim 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
    Next
Next
'统计清单上各项目的状态值
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
    Next
Next

End 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
    Next
Next
End Function

Function 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
    Next
Next

'定义表2统计每个数据包的报废流水号，首先定义列数
r2 = 1
For i = 1 To Sheet2.UsedRange.Rows.Count
        r2 = i
Next
MsgBox 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
    Next
Next
End Function



Sub 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.Select
End Sub

以上内容由PHP站长网【52php.cn】收集整理供大家参考研究

如果以上内容对您有帮助，欢迎收藏、点赞、推荐、分享。

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!