代码合并执行和控制变量运算区间

ALEX7710

各位大侠：      我在附件里的“各项目资金支出拟付款明细表”中写了三个代码，分别生产不同的数据。可有几个问题不知道怎么处理，请各位大侠帮帮忙，万分感谢！       问题：1、能否把3个代码合并到一个表单控件上执行。
                 2、能否控制代码运行的行数，例如用FOR...NEXT语句，控制X变量的运算区间是5到150。

MOY838840554

Sub 生成拟付款明细表()
    Dim max_row, coun, i, j
    Dim Aarr, Barr
    With Sheet3
        max_row = .Cells(Rows.Count, "C").End(3).Row
        coun = Application.WorksheetFunction.CountIf(.Range("N:N"), ">0") - 1
        '##########判断生成条目数量是否过多
        If coun > 147 Then
            coun = 147
            MsgBox "生成的明细表条目超过147，多余将舍去", , "提示"
        End If
        '##########N列>0写入数组Barr
        Aarr = .Range("A5:N" & max_row)
        ReDim Barr(1 To coun, 1 To 5)
        For i = 1 To UBound(Aarr)
            If Aarr(i, 14) > 0 Then
                j = j + 1
                Barr(j, 1) = j '序号
                Barr(j, 2) = Aarr(i, 2) '合同名称
                Barr(j, 3) = Aarr(i, 3) '施工单位
                Barr(j, 4) = Aarr(i, 14) '财务部审核付款金额
            End If
        Next i
        '##########清除和返回数据
        Sheet4.Range("A4:E150") = "" '清除之前生成的数据
        Sheet4.Range("A4:E" & coun + 3) = Barr '返回生成的数据
        MsgBox "生成完毕！", , "提示"
    End With
End Sub

ALEX7710

MOY838840554 发表于 2019-1-18 16:04
Sub 生成拟付款明细表()
    Dim max_row, coun, i, j
    Dim Aarr, Barr

运行流畅，万分感谢。

ALEX7710

MOY838840554 发表于 2019-1-18 16:04
Sub 生成拟付款明细表()
    Dim max_row, coun, i, j
    Dim Aarr, Barr

大侠：
       能不能再麻烦你一下。能否把附件中，从项目部到开发部的所有数据。都一次性生成到“各项目资金支出拟付款明细表”中？
       另外，要是能把提取到“各项目资金支出拟付款明细表”的数据，加上部门名称，那就更好了。
万分感谢！

MOY838840554

你自己增加一列，第2列为部门名称
Sub 汇总生成金泽伟业拟付款明细表4()
    Dim max_row, coun, i, j, sum&, name$
    Dim Aarr, Barr
    Dim sh As Worksheet
    '##########循环全部工作表，合计N列>0的数量
    For Each sh In Worksheets
        '判断该表A1单元格后5位是不是“资金计划表“
        If Right(sh.Range("A1"), 5) = "资金计划表" Then
            '累加N列>0的数量,-1为不统计第4行合计
            coun = coun + Application.WorksheetFunction.CountIf(sh.Range("N:N"), ">0") - 1
        End If
    Next
    '##########创建结果数组Barr
    ReDim Barr(1 To coun + 1, 1 To 6) '+1合计行
    '##########循环全部工作表
    For Each sh In Worksheets
        With sh
            '判断该表A1单元格后5位是不是“资金计划表“
            If Right(sh.Range("A1"), 5) = "资金计划表" Then
                max_row = .Cells(Rows.Count, "C").End(3).Row 'C列有数据的行数
                name = .Range("B2").Value '部门名称=B2单元格
                '##########N列>0写入数组Barr
                Aarr = .Range("A5:N" & max_row)
                For i = 1 To UBound(Aarr)
                    If Aarr(i, 14) > 0 Then '数组第14列(即原表N列)>0
                        j = j + 1
                        Barr(j, 1) = j '序号
                        Barr(j, 2) = name '部门名称
                        Barr(j, 3) = Aarr(i, 2) '合同名称
                        Barr(j, 4) = Aarr(i, 3) '施工单位
                        Barr(j, 5) = Aarr(i, 14) '财务部审核付款金额
                        sum = sum + Barr(j, 5) '合计累加
                    End If
                Next i
            End If
        End With
    Next
    '##########清除之前数据和格式
    max_row = Sheet4.Cells(Rows.Count, 1).End(3).Row
    If max_row > 3 Then
        With Sheet4.Range("A4:F" & max_row)
            .Value = "" '清除之前生成的数据
            .UnMerge '清除合并单元格(合计)
            .Interior.Pattern = xlNone '清除填充颜色
        End With
    End If
    '##########返回数据，设置格式
    max_row = j + 4
    Barr(coun + 1, 1) = "合计" '数组最后一行第1列
    Barr(coun + 1, 5) = sum '数组最后一行第5列,合计值sum
    With Sheet4.Range("A4:E" & coun + 4)
    .Value = Barr '返回生成的数据
    Sheet4.Range("A" & max_row & ":F" & max_row).Interior.Color = RGB(191, 191, 191) '最后一行填充灰色
    Sheet4.Range("A" & max_row & ":D" & max_row).Merge '最后一行A:D列合并单元格
    End With
    MsgBox "生成完毕！", , "提示"
End Sub

ALEX7710

MOY838840554 发表于 2019-1-18 18:01
你自己增加一列，第2列为部门名称
Sub 汇总生成金泽伟业拟付款明细表4()
    Dim max_row, coun, i, j, s ...

运行流畅，太牛了！！！
万分感谢！！！