合并来自不同Excel工作表基础列标题的数据

时间:2019-01-22 09:06:48

标签: excel vba

我正在从大约42个不同的excel工作表中创建一个excel仪表板。我正在尝试将所有工作表合并到一个主数据表中。 42个不同的工作表可能具有与另一个工作表相同的标题数或更多的标题。有人可以通过VBA代码帮助我,在那里我可以匹配列标题,如果匹配,则追加该列,否则在最后创建一个新列并将数据粘贴到那里。

我已经将所有工作表合并到一个工作表中,但是它不是预期的格式。

vendor: [
    'babel-es6-polyfill',

例如。

输入:

Function fn_LastRow(ByVal Sht As Worksheet)
    Dim lastRow As Long
    lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
    lRow = Sht.Cells.SpecialCells(xlLastCell).Row
    Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
        lRow = lRow - 1
    Loop
    fn_LastRow = lRow
End Function


Function fn_LastColumn(ByVal Sht As Worksheet)
    Dim lastCol As Long
    lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
    lCol = Sht.Cells.SpecialCells(xlLastCell).Column
    Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
        lCol = lCol - 1
    Loop
    fn_LastColumn = lCol
End Function


Sub Consolidate_Data()
    On Error GoTo IfError

    Dim Sht As Worksheet, DstSht As Worksheet
    Dim LstRow As Long, LstCol As Long, DstRow As Long
    Dim i As Integer, EnRange As String
    Dim SrcRng As Range
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Application.DisplayAlerts = False

    On Error Resume Next

    ActiveWorkbook.Sheets("Consolidate_Data").Delete
    Application.DisplayAlerts = True
    With ActiveWorkbook
        Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        DstSht.Name = "Consolidate_Data"
    End With
    For Each Sht In ActiveWorkbook.Worksheets
        If Sht.Name <> DstSht.Name Then
           DstRow = fn_LastRow(DstSht) + 1
           LstRow = fn_LastRow(Sht)
           LstCol = fn_LastColumn(Sht)
           EnRange = Sht.Cells(LstRow, LstCol).Address
           Set SrcRng = Sht.Range("A1:" & EnRange)
            If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
                MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
                GoTo IfError
            End If
            SrcRng.Copy Destination:=DstSht.Range("A" & DstRow)
        End If
    Next

IfError:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

我得到的输出:

Brand   1_day_growth    1_week_growth   1_month_growth
ABC     10      12      18
ACD     12      18      16

Brand   1_week_growth   2_week_growth    1_month_growth  6_month_growth
BCD     10      12      14      16
BDE     12      14      16      13

Brand   1_yr_growth
CDE     9

预期输出:

Brand   1_day_growth    1_week_growth    1_month_growth
ABC     10      12      18
ACD     12      18      16
Brand   1_week_growth   2_week_growth    1_month_growth     6_month_growth
BCD     10      12      14      16
BDE     12      14      16      13
Brand   1_yr_growth
CDE     9

0 个答案:

没有答案