Пытаюсь сделать с помощью макроса задачу, но не получается.
Есть таблица продаж в штуках различных артикулов по датам.
Названия столбцов - даты (могут повторяться, могут быть пустые).
Названия строк - артикулы (уникальные).
Нужно на другом листе в названия столбцов вывести месяцы и просуммировать по ним продажи для каждого артикула. Что-то типа сводной таблицы.
Как создать уникальный список месяцев для названий столбцов новой таблицы я придумал, осталось только придумать как просуммировать продажи по месяцам.
[вложение удалено администратором]
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