Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Создать формулы в коде VBA для динамического диапазона и записать их на лист
 
#1
03.12.2021 13:06:35
Макрос для подведения итогов по критериям. Критерии берутся с листа марки где могут добавляться данные. Желтым цветом выделено то что хотелось бы реализовать через макрос именно. и добавить их именно в последние строчки
 
 
 
#2
03.12.2021 15:38:52
, какой год ставить?  - поставил "никакой")
Код
Sub mrshkei()
Dim arr, arr2, i As Long, lr As Long, col As New Collection
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A2:C" & lr)
For i = LBound(arr) To UBound(arr)
    On Error Resume Next
    col.Add arr(i, 1), arr(i, 1)
Next i
ReDim arr2(1 To col.Count, 1 To 3)
For i = 1 To col.Count
    arr2(i, 1) = "ÈÒÎÃÈ ÏÎ " & col(i)
    arr2(i, 2) = Application.WorksheetFunction.SumIfs(Columns(2), Columns(1), col(i))
Next i
Cells(lr + 1, 1).Resize(UBound(arr2), 3) = arr2
End Sub
Изменено: Mershik - 03.12.2021 15:40:35
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
03.12.2021 18:16:31
Нужно чтобы брался критерий со второго лист

В примере выделено желтым. Нужны итоги по Маркам. Марки берутся из списка и вставляются по ним формулы =СУММЕСЛИ($A$2:$A$13;"Критерий из листа марки";$B$2:$B$13)
 
 
 
#4
03.12.2021 20:27:42
по-моему, гораздо проще это оставить самой обычной сводной. Ну или PQ
 
 
 
#5
04.12.2021 06:29:14
Название темы. Создать формулы в коде VBA для динамического диапазона и записать их на лист
Mershik Вы по моему мнению не так задачу поняли. Надо чтобы макрос записал на 1 лист что выделено желтым. те формулы. Коллекция авто не нужна  данные со 2 листа  

Сделал как понял.
Код
Sub SENxdsfg()
    Dim Rg1 As Range, Rg2 As Range, Arr1, i&
Set Rg1 = Worksheets("Аркуш1").Cells(1).CurrentRegion
Set Rg2 = Rg1.Parent.Cells(1).End(xlDown)(2, 1)
Arr1 = Worksheets("Марки").Cells(1).CurrentRegion
Rg2 = "ИТОГИ ПО МАРКАМ"

    For i = 2 To UBound(Arr1)
Rg2(i, 1) = "ИТОГИ ПО " & Arr1(i, 1)
Rg2(i, 2).FormulaLocal = "=СУММЕСЛИ(" & Rg1.Columns(1).Address & ";""=" & Arr1(i, 1) & """;" & Rg1.Columns(2).Address & ")"
Rg2(i, 3).FormulaLocal = "=СРЗНАЧЕСЛИ(" & Rg1.Columns(1).Address & ";""=" & Arr1(i, 1) & """;" & Rg1.Columns(3).Address & ")"
    Next
End Sub
 
 
 
#6
04.12.2021 15:14:15
Немного изменил. Создание выходного массива и выгрузка на лист одним оператором
Код
Sub SENDDD()
    Dim Rg1 As Range, Arr1, Arr2, i&
Set Rg1 = Worksheets("Аркуш1").Cells(1).CurrentRegion
    Arr1 = Worksheets("Марки").Cells(1).CurrentRegion
ReDim Arr2(1 To UBound(Arr1), 1 To 3)
    For i = 2 To UBound(Arr1)
Arr2(i, 1) = "ИТОГИ ПО " & Arr1(i, 1)
Arr2(i, 2) = "=СУММЕСЛИ(" & Rg1.Columns(1).Address & ";""=" & Arr1(i, 1) & """;" & Rg1.Columns(2).Address & ")"
Arr2(i, 3) = "=СРЗНАЧЕСЛИ(" & Rg1.Columns(1).Address & ";""=" & Arr1(i, 1) & """;" & Rg1.Columns(3).Address & ")"
    Next: Arr2(1, 1) = "ИТОГИ ПО МАРКАМ"
Set Rg1 = Rg1.Parent.Cells(1).End(xlDown)(2, 1)
Rg1.Resize(UBound(Arr1), UBound(Arr2, 2)).FormulaLocal = Arr2
End Sub
 
 
 
Страницы: 1
Наверх