ExcelHome技术论坛 › as42065300 › 日志

as42065300

https://club.excelhome.net/?1668501

2014-11-09

已有 991 次阅读2014-11-9 09:14 |个人分类:VBA汇总| 多工作簿汇总

Sub 取数()
Dim luj$, ba$, biaom$
Dim bo As Workbook
Dim 表名, 应收, 资金, 应付
表名 = Array("应收账款", "资金平衡", "应付款")
luj = ThisWorkbook.Path & "\汇总示意表\"             '这里的路径需改成和你工作薄对应的文件名称(我做的时候总表在【汇总示意表】文件外面)
    ba = Dir(luj & "*.xlsx")
    Application.ScreenUpdating = False
        Do While ba <> ""
            biaom = Left(Split(ba, ".")(0), 4)
                Set bo = Workbooks.Open(luj & ba)
                    应收 = bo.Sheets(表名(0)).UsedRange
                    资金 = bo.Sheets(表名(1)).UsedRange
                    应付 = bo.Sheets(表名(2)).UsedRange
                bo.Close False
                 ok = shk(应收, 资金, 应付, biaom)
                ba = Dir
         Loop
      Application.ScreenUpdating = True
End Sub

Private Function shk(应收, 资金, 应付, biaom)
   Dim h As Byte, x As Byte, s%, hr
   hr = Array(11, 13, 18, 19)
   h = 8
'*********************************************写入应收款******************************
   With Sheets("应收账款")
   s = .Cells(Rows.Count, 1).End(3).Row + 1
         If s = 4 Then s = s + 1                         由于数据源合并单元格造成需要增加行数只针对第一次写入数据
        .Cells(s, 1).Value = biaom
        .Cells(s, 2).Value = 应收(6, 2)
   For x = 3 To 21
        .Cells(s, x) = 应收(h, x)
   Next
   s = 0
   End With
   '***********************************************写入资金平衡************************
   With Sheets("资金平衡")
   s = .Cells(Rows.Count, 1).End(3).Row + 1
            If s = 4 Then s = s + 1                       '由于数据源合并单元格造成需要增加行数只针对第一次写入数据
        .Cells(s, 1).Value = biaom
    For x = 3 To 18
        .Cells(s, x) = 应收(h, x)
   Next
   s = 0
   End With
   '***************************************************写入应付款*******************************
   With Sheets("应付款")
        s = .Cells(Rows.Count, 3).End(3).Row + 1
            If s = 5 Then s = s + 1                       '由于数据源合并单元格造成需要增加行数只针对第一次写入数据
                .Cells(s, 1).Value = biaom
        For q = 0 To UBound(hr)
                For x = 2 To 22
                    .Cells(s, x) = 应付(hr(q), x)
                Next
              s = s + 1
        Next
   End With
End Function

'*****无聊写的只做为一个思路！