如何快速把几十个工作表汇总成一个工作表

aa123-456-1

都还没有看到一个要的字就没有了，谁可发一个上来呀，我也有同样的问题，每一次做的时候要花好多的时间呀！

wzd0604

看不懂啊

zjlinshi

要用到宏啊？好复杂啊！

wolftender

Private Sub CommandButton1_Click()
With Application.FileSearch
        .LookIn = ThisWorkbook.Path + "/dat"
        .Filename = "*.xls"
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                Sheet1.Cells(Sheet1.UsedRange.Rows.Count + 1, 1) = .FoundFiles(i)
                Set wb = GetObject(.FoundFiles(i))
                rng = "a2:g" & wb.Sheets(1).UsedRange.Rows.Count
                wb.Sheets(1).Range(rng).Copy Sheet1.Cells(Sheet1.UsedRange.Rows.Count, 2)
                wb.Close
                Set wb = Nothing
            Next i
        End If
End With
End Sub

paipaitemp

先用宏程序将各工作簿中的各表汇总到一个工作表中,再用宏程序删除各表的空行空列,再设置一个标准格式的工作表,将其他表依此格式标准化并移动到一个新工作簿中,最后对该工作簿进行表间汇总.相关VBA语言如下:

Sub 将同路径下多薄中的表合并为当前活动薄的多张表()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim lj, dirname, nm
    Dim a As Long
    Dim i As Long
    lj = ActiveWorkbook.Path
    nm = ActiveWorkbook.Name
    dirname = Dir(lj & "\*.xls")
    Do While dirname <> ""
        If dirname <> nm Then
            Workbooks.Open Filename:=lj & "\" & dirname
            a = Sheets.Count  '读当前工作薄中的所有的工作表
            For i = 1 To a
            Workbooks(dirname).Activate
             If IsSheetEmpty = IsEmpty(Sheets(i).UsedRange) Then Sheets(i).Cells.ClearFormats            '删除各表的格式
             Sheets(i).Copy Before:=Workbooks(nm).Sheets(1) '不为空的工作表进行合并
            Next i
            Workbooks(dirname).Close False
        End If
        dirname = Dir
    Loop
End Sub

paipaitemp

Sub 批量删除当前工作簿各表的空行空列()
Dim Sht As Worksheet
Dim Row_Max As Integer
Dim column_Max As Integer
Row_Max = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).row
column_Max = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).column
    Dim i As Integer
    Dim j As Integer
With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Cursor = xlWait
End With
 For Each Sht In Worksheets
    For i = Row_Max To 1 Step -1
    If Application.WorksheetFunction.CountA(Sht.Rows(i)) = 0 Then
    Sht.Rows(i).Delete
    End If
    Next
    For j = column_Max To 1 Step -1
    If Application.WorksheetFunction.CountA(Sht.Columns(j)) = 0 Then
    Sht.Columns(j).Delete
    End If
    Next
    Next
With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .Cursor = xlDefault
End With
End Sub

paipaitemp

Sub 以标准表为模板将其他表改成标准表试样并移动到新簿()
Set newbook = Workbooks.Add
With newbook
.SaveAs Filename:="簿一"
End With
ThisWorkbook.Activate
Dim Sht As Worksheet
Dim Rw As Range
With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Cursor = xlWait
End With
For Each Sht In ThisWorkbook.Worksheets
If Sht.Name <> "标准" And Sht.Cells(1, 1) = Sheets("标准").Cells(1, 1) Then
        For Each Rw In Sht.UsedRange.Rows
                If Application.WorksheetFunction.CountA(Rw) = 0 Then
                        Rw.Delete
                End If
        Next
        Sheets("标准").Columns("A:L").Copy
        Sht.Columns("A:L").PasteSpecial Paste:=xlPasteFormats
        Sht.Tab.ColorIndex = 43
        Sht.Move Before:=newbook.Sheets(1)
        ThisWorkbook.Activate
    Else:
        Sht.Move Before:=Sheets(1)
End If
Next
With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .Cursor = xlDefault
End With
End Sub

 

之后用公式SUM(SHEET1:SHEET456!b2)汇总即可,我用上述方法将456张表在3分钟内搞定.当然,之前摸索花了一星期,在EXCEL吧(20381571)里向AD等高手请教,最终得出上面的结果.

hangtian2006

paipaitemp:能用例子把你编的宏具体应用一下吗?

shenshen0455

有没有人来评价一下啊，哪种方法最好？

hyy700719

我也想知道