Свод по нескольким листам Excel - VBA

Узнай цену своей работы

Формулировка задачи:

Всем привет, очень нужна помощь ! Есть такая задачка : в файле Excel имеется несколько листов ( может быть от 1 до 100 примерно ) , в этих листах данные по продаже товаров ( некоторые наименования товаров в разных листах повторяются ) . Ломаю голову на тем, как сделать макрос , в который будет собирать данные из всех листов, вставлять в новый лист (созданный перед всеми) , оставлять только уникальные названия и суммировать информацию по повторяющимся . С макросами я пока не совсем на "ты" , кое что сделать могу , но с такой задачей справиться не получается . Помогите , плиз. пример файла прикрепил. Заранее благодарю.

Решение задачи: «Свод по нескольким листам Excel»

textual
Листинг программы
Private Sub Test1()
    Dim iArr(), iCount%
    aSum = Array(2, 3, 4, 6, 7) 'массив суммирования (№№ столбцов)
    aCr = Array(1, 5) 'массив критериев (№№ столбцов)
    With CreateObject("Scripting.Dictionary")
        zg = Sheets(1).Range("B2:H2")
        For Each sh In Sheets
            a = sh.[B2].CurrentRegion
            For i = 2 To UBound(a)
                For Each el In aCr
                    t = t & a(i, el)
                Next
                If .exists(t) Then
                    b = .Item(t)
                    For Each el In aSum
                        b(el) = b(el) + a(i, el)
                    Next
                Else
                    b = Application.Index(a, i, , 1)
                End If
                .Item(t) = b
                t = ""
            Next
        Next
        a = Application.Transpose(.items)
        Workbooks.Add.Worksheets(1).[A2].Resize(.Count, 7) = Application.Transpose(a)
        [a1].Resize(1, 7) = zg
        Columns("A:A").AutoFit
        ActiveSheet.UsedRange.Sort Key1:=Range("A1"), Header:=xlYes
    End With
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

11   голосов , оценка 4 из 5