[VBA]匯總多個工作簿的指定工作表到同一個工作簿的指定工作表中


sub 匯總多個工作簿()

Application.ScreenUpdating = False

Dim wb As Workbook, f As String, l As String, n As String, m As String, j As Integer

    f = ThisWorkbook.Path & "\"

    l = f & "*.xls"

    m = Dir(l)

    Do While m <> ""

        If m <> ThisWorkbook.Name Then

        n = f & m

        Workbooks.Open (n)

         With ThisWorkbook.activesheet

        .Range("b4:at34").ClearContents

        For i = 4 To .Range("a1").CurrentRegion.Rows.Count

        For j = 2 To .Range("a1").CurrentRegion.Columns.Count - 2 Step 3

        For Each wb In Workbooks

            If wb.Name <> ThisWorkbook.Name Then

             aa = Left(wb.Name, InStrRev(wb.Name, ".") - 1)

                If .Cells(2, j).Value = aa Then

                .Cells(i, j) = Application.VLookup(.Cells(i, 1), wb.Worksheets(1).Range("a:b"), 2, 0)

                .Cells(i, j + 1) = Application.VLookup(.Cells(i, 1), wb.Worksheets(1).Range("a:c"), 3, 0)

                    If VBA.IsNumeric(ThisWorkbook.activesheet.Cells(i, j + 1)) = False Then

                    ThisWorkbook.activesheet.Cells(i, j + 2) = 0

                    ElseIf ThisWorkbook.activesheet.Cells(i, j + 1) = 0 Then

                    ThisWorkbook.activesheet.Cells(i, j + 2) = 0

                    Else

                    ThisWorkbook.activesheet.Cells(i, j + 2) = ThisWorkbook.activesheet.Cells(i, j) / ThisWorkbook.activesheet.Cells(i, j + 1)

                    End If

                End If

            End If

        Next

        Next

        Next

        End With

        End If

        m = Dir

    Loop

   For Each wb In Workbooks

    If wb.Name <> ThisWorkbook.Name Then

    wb.Close False

    End If

    Next

Application.ScreenUpdating = True

End Sub

 

 

效果圖:

不足:

調用excel本身的函數vlookup,數據量大的話,會導致運行速度慢,表格卡住的問題,后期優化,應用數組解決。

 


免責聲明!

本站轉載的文章為個人學習借鑒使用,本站對版權不負任何法律責任。如果侵犯了您的隱私權益,請聯系本站郵箱yoyou2525@163.com刪除。



 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM