Макрос Excel: как скопировать все строки из 3 листов и объединить строки, уникальные в первом столбце?

Вот один способ.

Option Explicit

Sub Test()
    Dim sheetNames: sheetNames = Array("Sheet1", "Sheet2", "Sheet3")
    Dim target As Worksheet: Set target = Worksheets("Sheet4")
    Dim accounts As New Dictionary
    Dim balances As New Dictionary
    Dim source As Range
    Dim row As Range
    Dim id As String
    Dim account As String
    Dim balance As Double
    Dim sheetName: For Each sheetName In sheetNames
        Set source = Worksheets(sheetName).Range("A1").CurrentRegion
        Set source = source.Offset(1, 0).Resize(source.Rows.Count - 1, source.Columns.Count)
        For Each row In source.Rows
            id = row.Cells(1).Value
            account = row.Cells(2).Value
            balance = row.Cells(3).Value
            accounts(id) = account
            If balances.Exists(id) Then
                balances(id) = balances(id) + balance
            Else
                balances(id) = balance
            End If
        Next row
    Next sheetName

    Call target.Range("A2:A65536").EntireRow.Delete

    Dim rowIndex As Long: rowIndex = 1
    Dim key
    For Each key In accounts.Keys
        rowIndex = rowIndex + 1
        target.Cells(rowIndex, 1).Value = key
        target.Cells(rowIndex, 2).Value = accounts(key)
        target.Cells(rowIndex, 3).Value = balances(key)
    Next key
End Sub

1. Создайте новый модуль (редактор VBA -> Вставить -> Модуль) и вставьте в него приведенный выше код.

2. Добавьте ссылку на Microsoft Scripting Runtime (редактор VBA -> Инструменты -> Ссылки -> Отметьте Microsoft Scripting Runtime).

3. Запустите его, поместив курсор в код и нажав F5.

Очевидно, листы должны называться Sheet1, Sheet2, Sheet3 и Sheet4. Он не будет вставлять заголовки столбцов в Sheet4, но, по-видимому, они статичны, поэтому вы можете просто настроить их заранее.

На самом деле вы хотите запустить макрос или что-то еще, что копирует все ваши данные с трех листов на новый лист, а затем запускает сводную таблицу на основе результата. Сводные таблицы обрабатывают уникальность вашего набора данных и агрегацию данных для множественности.

Вы можете использовать следующий код VB (введите Alt-F11 в Excel, чтобы перейти к редактору VBA, вставьте новый модуль и вставьте в него этот код). Этот код предполагает, что ваша электронная таблица имеет три листа с именами Sheet1, Sheet2 и Sheet3, которые содержат ваши данные, и что данные непрерывны и начинаются в ячейке A1 на каждом листе. Также предполагается, что в вашей электронной таблице есть лист с именем «Сводная таблица», на который будут скопированы все данные.

Sub CopyDataToPivotSheet()

  Sheets("Pivot Sheet").Select
  Range("A1:IV65536").Select
  Selection.Clear

  Sheets("Sheet1").Select
  Range("A1").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.Copy
  Sheets("Pivot Sheet").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

  Sheets("Sheet2").Select
  Range("A1").Select
  Range(Selection, Selection.End(xlDown)).Select
  Range(Selection, Selection.End(xlToRight)).Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("Pivot Sheet").Select
  Range("A1").Select
  Selection.End(xlDown).Offset(1, 0).Range("A1").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

  Sheets("Sheet3").Select
  Range("A1").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("Pivot Sheet").Select
  Selection.End(xlDown).Select
  Range("A1").Select
  Selection.End(xlDown).Offset(1, 0).Range("A1").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

  Rows("1:1").Select
  Application.CutCopyMode = False
  Selection.Insert Shift:=xlDown
  Range("A1").Select
  ActiveCell.FormulaR1C1 = "AccountNum"
  Range("B1").Select
  ActiveCell.FormulaR1C1 = "Description"
  Range("C1").Select
  ActiveCell.FormulaR1C1 = "Total"

End Sub

Это 95% сгенерированный код excel (через макрос записи), но я изменил некоторые вещи, чтобы сделать его более общим. В любом случае, вы можете назначить этот макрос кнопке обычным способом или назначить его сочетанию клавиш через диалог Инструменты => Макрос => Макросы ... Параметры ....

В любом случае, ваши данные будут агрегированы на сводной таблице с соответствующими заголовками.

Затем вы можете перейти в Data => PivotTable and PivotChart Report. Нажмите «Далее», выберите данные на сводной таблице (включая заголовки!), Нажмите «Далее» и выберите «Макет».

Перетащите поле AccountNumber (справа от мастера) в область с надписью «Строка». Перетащите поле «Описание» под поле «Номер счета» в области «Строка». Перетащите поле «Итого» в область «Данные», затем дважды щелкните по нему в области «Данные» и выберите «Сумма», чтобы оно агрегировало это поле. Нажмите OK, и вы должны получить сводную таблицу. Вероятно, вы захотите скрыть промежуточные итоги, щелкнув правой кнопкой мыши заголовок промежуточных итогов (например, «бла-бла Всего») и выбрав «Скрыть». Этот результат в основном выглядит точно так же, как и ваш желаемый результат.

Если вы хотите пофантазировать, вы могли бы автоматизировать этот последний абзац, но, вероятно, это того не стоит.

Надеюсь это поможет!

Я думаю, что ADO лучше всего подходит для этого, здесь вы найдете некоторые примечания: Функция обнаружения дубликатов в листе Excel

Вы можете использовать подходящую строку SQL для объединения и группировки ваших записей.

Например:

strSQL = "SELECT F1, F2, Sum(F3) FROM (" _
       & "SELECT F1,F2,F3 FROM [Sheet1$] " _
       & "UNION ALL " _
       & "SELECT F1,F2,F3 FROM [Sheet2$] " _
       & "UNION ALL " _
       & "SELECT F1,F2,F3 FROM [Sheet3$] ) " _
       & "GROUP BY F1, F2"