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

　　产量记录管理，本文内容中关于产量录入，统计的一些基本功能。
　　如需要，可及时收藏备用。
　　上图为录入页，形式简单只有相关人员日期和数量，如果需要可以再进行添加。
　　上图为统计表，可以对某人的某个月进行记录统计，实际上也算一个查询的功能。
　　上图为月度统计表。
　　每月统计数据实现统计计算。
　　代码
　　数据录入Sub 录入信息() On Error Resume Next Dim xArr(1 To 4) xArr(1) = Range(＂D3＂).Value xArr(2) = Range(＂F3＂).Value xArr(3) = Range(＂D4＂).Value xArr(4) = Range(＂F4＂).Value Dim s As Worksheet Set s = ThisWorkbook.Worksheets(＂产量统计表＂) Dim ir As Integer, ic As Integer ir = 3 ic = 4 s.Cells(ir, 1).Resize(1, ic).Insert shift:=xlShiftDown With 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 = xArr End With ir = s.Cells(s.Rows.Count, 1).End(xlUp).Row s.Cells(ir, 3).Formula = ＂=Sum(C3:C＂ & ir - 1 & ＂)＂ s.Cells(ir, 4).Formula = ＂=Sum(D3:D＂ & ir - 1 & ＂)＂ Set s = Nothing Erase xArr End Sub
　　个人统计Sub 个人搜索() On Error Resume Next Dim xName As String, xCountA As Double, xCountB As Double, xMouth As Integer Dim s As Worksheet Set s = ActiveSheet DelCells s xName = VBA.UCase(VBA.Trim(Range(＂F2＂).Value)) If VBA.Len(xName) = 0 Then Exit Sub If Not VBA.IsNumeric(s.Range(＂F3＂).Value) Then MsgBox ＂月份错误！请输入1~12之间数字＂: Exit Sub xMouth = Range(＂F3＂).Value If xMouth > 12 Then MsgBox ＂月份错误！请输入1~12之间数字＂: Exit Sub Dim xR As Range, r As Range  Dim xArr, ir As Long, ic As Long, i As Long, eir As Long  xArr = s.Range(＂A2＂).CurrentRegion ir = UBound(xArr, 1) ic = 2 For 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 If Next 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 With Erase xArr Set s = Nothing End Sub
　　月度汇总Sub 月度汇总() On Error Resume Next Dim xCountA As Double, xCountB As Double, xMouth As Integer Dim s As Worksheet, c As Worksheet, j As Worksheet, jr As Long Set s = ThisWorkbook.Worksheets(＂设置＂) Set c = ThisWorkbook.Worksheets(＂产量统计表＂) Set j = ActiveSheet j.Cells(3, 1).Resize(j.UsedRange.Rows.Count - 2, 4).Delete If Not VBA.IsNumeric(s.Range(＂E1＂).Value) Then Exit Sub xMouth = Range(＂E1＂).Value Dim xArr, xi As Long, ir As Long, ic As Long xArr = c.Range(＂A2＂).CurrentRegion ir = UBound(xArr, 1) ic = 2 Dim sArr, si As Long, sr As Long sr = s.Cells(1, 1).End(xlDown).Row sArr = 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 With Next si j.Range(＂A1＂).Value = xMouth & ＂月度汇总表＂ Erase xArr Set j = Nothing Set s = Nothing Set c = Nothing End Sub
　　产量统计也是一个重要的环节，特别是一些中小型企业，生产密集型企业更是需要一个高效的统计表来进行结算。
　　如有需要可以查看产量统计表，Excel vba。
　　欢迎关注、收藏
　　---END---