Теория Excel: объединение данных из нескольких вкладок в одну вкладку

Question

У меня есть 4 листа данных с тысячами строк на каждом листе.На каждом листе есть один столбец, который я хотел бы объединить в 5-й лист.В этом столбце я хотел бы убедиться, что каждое имя из предыдущих четырех листов включено в один полный список без повторов.

См. Простой пример ниже, но представьте 20 000 строк на каждом листе со сложнымимена.Кто-нибудь может придумать способ сделать это, который не требует настройки каждый раз, когда изменяются входные данные?Я безуспешно пытаюсь использовать Мастер сводок.

Sheet 1     Sheet 2     Sheet 3     Sheet 4      Ideal Sheet 5
Dog          Cat         Fish       Giraffe       Dog
Hamster      Dog         Lhama      Cat           Cat
Giraffe      Elephant    Dog        Fish          Fish
                                                 Giraffe
                                                 Elephant
                                                 Hamster
                                                  Lhama

Вот код, который я придумал, чтобы решить эту проблему на случай, если кому-то будет интересно.«Zone & Fam» просто указывает интересующий меня столбец.

Sub GetUniqueZoneFam()
    Application.ScreenUpdating = False

    Dim Lastrow As Long

    Worksheets("Calculation Indv").Range("A:A").ClearContents

    Worksheets("fcst fg").Activate
    Range("Fcst_Fg[Zone & Fam]").Copy
    Worksheets("Calculation Indv").Activate
    Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    Worksheets("fcst ps").Activate
    Range("Fcst_PS[Zone & Fam]").Copy
    Worksheets("Calculation Indv").Activate
    Range("A" & Lastrow + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    Worksheets("sales fg").Activate
    Range("Sales_FG[Zone & Fam]").Copy
    Worksheets("Calculation Indv").Activate
    Range("A" & Lastrow + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    Worksheets("sales ps").Activate
    Range("Sales_PS[Zone & Fam]").Copy
    Worksheets("Calculation Indv").Activate
    Range("A" & Lastrow + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    Application.CutCopyMode = False

    Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A1").Select

    Worksheets("Calculation Indv").Range("A1").Value = "Zone & Fam"
    Worksheets("Calculation Indv").Range("A1").Font.Bold = True


    Application.ScreenUpdating = True
    MsgBox ("Done!")

End Sub

Answer 1

Sub GetUniqueZoneFam () Application.ScreenUpdating = False

Dim Lastrow As Long

Worksheets("Calculation Indv").Range("A:A").ClearContents

Worksheets("fcst fg").Activate
Range("Fcst_Fg[Zone & Fam]").Copy
Worksheets("Calculation Indv").Activate
Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

Worksheets("fcst ps").Activate
Range("Fcst_PS[Zone & Fam]").Copy
Worksheets("Calculation Indv").Activate
Range("A" & Lastrow + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

Worksheets("sales fg").Activate
Range("Sales_FG[Zone & Fam]").Copy
Worksheets("Calculation Indv").Activate
Range("A" & Lastrow + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

Worksheets("sales ps").Activate
Range("Sales_PS[Zone & Fam]").Copy
Worksheets("Calculation Indv").Activate
Range("A" & Lastrow + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

Application.CutCopyMode = False

Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
Range("A1").Select

Worksheets("Calculation Indv").Range("A1").Value = "Zone & Fam"
Worksheets("Calculation Indv").Range("A1").Font.Bold = True


Application.ScreenUpdating = True
MsgBox ("Done!")

End Sub

Answer 2

В vba это будет выглядеть примерно так (полностью не протестировано, написано за пределами VBE, возможно, изобилует ошибками, определенно потребуется подстройка под ваши имена листов и столбцы, в которых живут ваши данные):

Dim wsName as String
Dim lastRow as Long
Dim writeRow as Long

'set the row on which we are going to start writing data to "Sheet 5"
writeRow = 1

'Loop though your sheets to copy from
For Each wsName In Array("Sheet 1", "Sheet 2", "Sheet 3", "Sheet 4")

    'determine the last used row in the worksheet we are copying from
    lastRow = Sheets(wsName).Range("A1").End(xlDown).Row

    'grab the data
    Sheets(wsName).Range("A1:A" & lastRow).Copy Destination:=Sheets("Sheet 5").Range("A" & writeRow)

    'increment the writeRow
    writeRow = writeRow + lastRow

Next wsName

'Now that all the data is copied, dedup it
Sheets("Sheet 5").Range("A1:A" & writeRow).RemoveDuplicates Columns:=Array(1), Header:=xlNo