Консолидация данных из заголовка столбца различных таблиц Excel - PullRequest
0 голосов
/ 22 января 2019

Я создаю панель инструментов Excel из 42 различных таблиц Excel.Я пытаюсь объединить все рабочие листы в один лист основных данных.42 различных листа могут иметь такое же количество заголовков, что и другие листы, или несколько заголовков.Может ли кто-нибудь помочь мне с кодом VBA, где я могу сопоставить заголовки столбцов и, если он совпадает, добавить столбец или создать последний столбец и вставить туда данные.

Я объединил все рабочие листы в один рабочий лист, но он не в ожидаемом формате.

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

Ожидаемый вывод:

Brand   1_day_growth    1_week_growth   1_month_growth  2_week_growth   6_week_growth   1_yr_growth
ABC     10      12      18
ACD     12      18      16
BCD     -       10      14      12      16
BDE     -       12      16      14      13
CDE     -       -       -       -       -       9
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...