Excel VBA Макросы: Суммирование значений по месяцам в строках.

Автор Дмитрий, 21 июня 2019, 23:44

Дмитрий

Пытаюсь сделать с помощью макроса задачу, но не получается.

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

Нужно на другом листе в названия столбцов вывести месяцы и просуммировать по ним продажи для каждого артикула. Что-то типа сводной таблицы.

Как создать уникальный список месяцев для названий столбцов новой таблицы я придумал, осталось только придумать как просуммировать продажи по месяцам.

[вложение удалено администратором]

Администратор

1. Макрос писался, когда вверху модуля эти опции:
Option Explicit
Option Compare Text
Option Base 1

2. Макрос не анализирует на листе "Продажи" столбец A: предполагается, что расположение артикулов на двух листах одинаковое.

3. Предполагается, что перед запуском макроса, на листе "Продажи" в строке 2 будут записаны месяцы.

Макрос
Sub Макрос()

    Dim sh_src As Worksheet, src(), sh_res As Worksheet, res()
    Dim мес_ист(), мес_рез(), j_мес As Long
    Dim lr As Long, lc As Long, i As Long, j As Long
   
   
    '1. Присваиваем листам имена. Далее в коде будем обращаться к листам по этим именам.
    Set sh_src = Worksheets("Отгружено")
    Set sh_res = Worksheets("Продажи")
   
    '2. Запись месяцев в массивы.
        ' End не ищет в скрытых строках, столбцах.
       
    '1) Месяцы из листа-источника. Даты переводим в месяцы.
    lc = sh_src.Cells(1, sh_src.Columns.Count).End(xlToLeft).Column
    мес_ист() = sh_src.Range(sh_src.Range("F1"), sh_src.Cells(1, lc)).Value
    For j = 1 To UBound(мес_ист, 2)
        If мес_ист(1, j) <> "" Then
            мес_ист(1, j) = Month(мес_ист(1, j))
        End If
    Next j
   
    '2) Месяцы из листа-результата.
    lc = sh_res.Cells(2, sh_res.Columns.Count).End(xlToLeft).Column
    мес_рез() = sh_res.Range(sh_res.Range("D2"), sh_res.Cells(2, lc)).Value
   
    '3. Копирование данных из листа-источника в массив. С массивом макрос будет быстрее работать,
        ' если данных много.
    lr = sh_src.Cells(sh_src.Rows.Count, "A").End(xlUp).Row
    lc = sh_src.Cells(1, sh_src.Columns.Count).End(xlToLeft).Column
    src() = sh_src.Range(sh_src.Range("F4"), sh_src.Cells(lr, lc)).Value
   
    '4. Создание ячеек в массиве-результате. Сначала в него запишем данные, а потом вставим на лист.
        ' Так будет быстрее, если данных много.
    ReDim res(UBound(src), UBound(мес_рез, 2))
   
    '5. Подсчёт по месяцам.
    For j_мес = 1 To UBound(мес_рез, 2)
        For j = 1 To UBound(src, 2)
            If мес_ист(1, j) = мес_рез(1, j_мес) Then
                For i = 1 To UBound(src, 1)
                    res(i, j_мес) = res(i, j_мес) + src(i, j)
                Next i
            End If
        Next j
    Next j_мес
   
    '6. Вставка массива на лист.
    sh_res.Range("D3").Resize(UBound(res, 1), UBound(res, 2)).Value = res()
   
    '7. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub
[свернуть]

Дмитрий

Огромное спасибо!
Очень элегантное решение. Работает реально быстро!