|
Sub 汇总生成金泽伟业拟付款明细表5()
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") - IIf(sh.Range("N4") > 0, 1, 0) '根据N4合计值看是否要-1
End If
Next
'##########创建结果数组Barr
ReDim Barr(1 To coun + 1, 1 To 6) '+1合计行
'##########循环全部工作表
For Each sh In Worksheets
With sh
max_row = .Cells(Rows.Count, "C").End(3).Row 'C列有数据的行数
'判断该表A1单元格后5位是不是“资金计划表“
If Right(sh.Range("A1"), 5) = "资金计划表" And max_row >= 5 Then '增加判断行数大于等于5
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 "生成完毕!", , "提示"
'Stop
End Sub |
|