用VBA数组把几个班级工作表汇总

laoau138

用VBA数组把几个班级工作表汇总

605751967

http://www.excelpx.com/thread-343216-1-1.html

hasyh2008

Sub 汇总()
Sheets("汇总").Columns("A:i").Clear
    Dim i%, tim
    tim = Timer

    For i = 1 To Sheets.Count - 1
        Sheets(i).Select
        Columns(1).Insert
        Range("A1").Resize(Range("B" & Rows.Count).End(xlUp).Row, 1) = Sheets(i).Name
        Sheets(i).Range("A1").CurrentRegion.Copy Sheets("汇总").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Sheets(i).Columns(1).Delete
    Next i

    Sheets("汇总").Select

    Dim strDep  As String
    Dim Rng     As Range
    Dim Rown%, Rown2%, X%

    X = Range("A" & Rows.Count).End(xlUp).Row

    strDep = Cells(2, 1).Value
    Set Rng = Cells(2, 1)
    '关闭警告提示
    Application.DisplayAlerts = False

    For Rown = 2 To X + 1
        If strDep = Cells(Rown, 1).Value Then
            Set Rng = Union(Rng, Cells(Rown, 1))
        Else
            Rng.Merge
            strDep = Cells(Rown, 1).Value
            Set Rng = Cells(Rown, 1)
        End If
    Next Rown
    '开启警告提示
    Application.DisplayAlerts = True
    MsgBox Timer - tim
End Sub

laoau138

hasyh2008 发表于 2018-7-18 11:21
Sub 汇总()
    Dim i%
    For i = 1 To Sheets.Count - 1

实在太高手了

hasyh2008

laoau138 发表于 2018-7-18 11:54
实在太高手了

并不难，只要用心学，很容易的！关于单工作簿内多表合并的教程很多！