报表统计(VBA编程源码下载，产量统计，月度生产报表统计)

Posted 2023-05-27

篇首语：忙于采集的蜜蜂，无暇在人前高谈阔论。本文由小常识网(cha138.com)小编为大家整理，主要介绍了报表统计(VBA编程源码下载，产量统计，月度生产报表统计)相关的知识，希望对你有一定的参考价值。

报表统计(VBA编程源码下载，产量统计，月度生产报表统计)

产量记录管理，本文内容中关于产量录入，统计的一些基本功能。

如需要，可及时收藏备用。

上图为录入页，形式简单只有相关人员日期和数量，如果需要可以再进行添加。

上图为统计表，可以对某人的某个月进行记录统计，实际上也算一个查询的功能。

上图为月度统计表。

每月统计数据实现统计计算。

代码

数据录入

Sub 录入信息()On Error Resume NextDim xArr(1 To 4)xArr(1) = Range("D3").ValuexArr(2) = Range("F3").ValuexArr(3) = Range("D4").ValuexArr(4) = Range("F4").ValueDim s As WorksheetSet s = ThisWorkbook.Worksheets("产量统计表")Dim ir As Integer, ic As Integerir = 3ic = 4s.Cells(ir, 1).Resize(1, ic).Insert shift:=xlShiftDownWith s.Cells(ir, 1).Resize(1, ic)    .Clear    .ClearFormats    .RowHeight = 18    .HorizontalAlignment = xlCenter    .VerticalAlignment = xlCenter    .Borders.LineStyle = 1    .Item(1).NumberFormat = "yyyy/mm/dd"    .Value = xArrEnd Withir = s.Cells(s.Rows.Count, 1).End(xlUp).Rows.Cells(ir, 3).Formula = "=Sum(C3:C" & ir - 1 & ")"s.Cells(ir, 4).Formula = "=Sum(D3:D" & ir - 1 & ")"Set s = NothingErase xArrEnd Sub

个人统计

Sub 个人搜索()On Error Resume NextDim xName As String, xCountA As Double, xCountB As Double, xMouth As IntegerDim s As WorksheetSet s = ActiveSheetDelCells sxName = VBA.UCase(VBA.Trim(Range("F2").Value))If VBA.Len(xName) = 0 Then Exit SubIf Not VBA.IsNumeric(s.Range("F3").Value) Then MsgBox "月份错误！请输入1~12之间数字": Exit SubxMouth = Range("F3").ValueIf xMouth > 12 Then MsgBox "月份错误！请输入1~12之间数字": Exit SubDim xR As Range, r As Range Dim xArr, ir As Long, ic As Long, i As Long, eir As Long xArr = s.Range("A2").CurrentRegionir = UBound(xArr, 1)ic = 2For i = LBound(xArr, 1) + 1 To ir    If VBA.IsDate(xArr(i, 1)) Then        If xMouth = VBA.DatePart("m", xArr(i, 1)) Then                    If VBA.DatePart("d", xArr(i, 1)) <= 26 Then                        If VBA.UCase(xArr(i, 2)) = xName Then                            xCountA = xCountA + VBA.CDbl(xArr(i, 3))                            xCountB = xCountB + VBA.CDbl(xArr(i, 4))                            AddCells xArr, s, i                        End If                    End If        ElseIf xMouth - 1 = VBA.DatePart("m", xArr(i, 1)) Then                    If VBA.DatePart("d", xArr(i, 1)) > 26 Then                        If VBA.UCase(xArr(i, 2)) = xName Then                            xCountA = xCountA + VBA.CDbl(xArr(i, 3))                            xCountB = xCountB + VBA.CDbl(xArr(i, 4))                            AddCells xArr, s, i                        End If                    End If        End If    End IfNext i    eir = s.Range("G" & s.Rows.Count).End(xlUp).Row    eir = eir + 1    If eir > 2 Then        s.Range("G" & eir).Value = "合计"        s.Range("H" & eir).Value = xName        s.Range("I" & eir).Value = xCountA        s.Range("J" & eir).Value = xCountB    End If    With s.Range("G3:J" & eir)        .Borders.LineStyle = 1        .HorizontalAlignment = xlCenter        .VerticalAlignment = xlCenter        .RowHeight = 20    End WithErase xArrSet s = NothingEnd Sub

月度汇总

Sub 月度汇总()On Error Resume NextDim xCountA As Double, xCountB As Double, xMouth As IntegerDim s As Worksheet, c As Worksheet, j As Worksheet, jr As LongSet s = ThisWorkbook.Worksheets("设置")Set c = ThisWorkbook.Worksheets("产量统计表")Set j = ActiveSheetj.Cells(3, 1).Resize(j.UsedRange.Rows.Count - 2, 4).DeleteIf Not VBA.IsNumeric(s.Range("E1").Value) Then Exit SubxMouth = Range("E1").ValueDim xArr, xi As Long, ir As Long, ic As LongxArr = c.Range("A2").CurrentRegionir = UBound(xArr, 1)ic = 2Dim sArr, si As Long, sr As Longsr = s.Cells(1, 1).End(xlDown).RowsArr = s.Range("A2:A" & sr)sr = UBound(sArr, 1)For si = LBound(sArr, 1) To sr                                        xCountA = 0                                        xCountB = 0    For xi = LBound(xArr, 1) To ir        If VBA.UCase(xArr(xi, ic)) = VBA.UCase(sArr(si, 1)) Then        '如果姓名相同                 If VBA.IsDate(xArr(xi, 1)) Then                     If xMouth = VBA.DatePart("m", xArr(xi, 1)) Then                                If VBA.DatePart("d", xArr(xi, 1)) <= 26 Then                                        xCountA = xCountA + VBA.CDbl(xArr(xi, 3))                                        xCountB = xCountB + VBA.CDbl(xArr(xi, 4))                                End If                    ElseIf xMouth - 1 = VBA.DatePart("m", xArr(xi, 1)) Then                               If VBA.DatePart("d", xArr(xi, 1)) > 26 Then                                        xCountA = xCountA + VBA.CDbl(xArr(xi, 3))                                        xCountB = xCountB + VBA.CDbl(xArr(xi, 4))                                End If                    End If                End If        End If    Next xi    jr = j.Cells(j.Rows.Count, 1).End(xlUp).Row + 1    j.Cells(jr, 1).Value = "=row()-2"    j.Cells(jr, 2).Value = sArr(si, 1)    j.Cells(jr, 3).Value = xCountA    j.Cells(jr, 4).Value = xCountB    With j.Cells(jr, 1).Resize(1, 4)        .RowHeight = 18        .Borders.LineStyle = 1        .HorizontalAlignment = xlCenter        .VerticalAlignment = xlCenter    End WithNext sij.Range("A1").Value = xMouth & "月度汇总表"Erase xArrSet j = NothingSet s = NothingSet c = NothingEnd Sub

产量统计也是一个重要的环节，特别是一些中小型企业，生产密集型企业更是需要一个高效的统计表来进行结算。

如有需要可以查看产量统计表，Excel vba。

欢迎关注、收藏

---END---