Добрый день Уважаемые форумчане.. Подскажите пожалуйста как записать формулу "суммеслимн" в макрос. По-сути из листа "отсюда" собираются уникальные фамилии в лист "сюда", затем создается отчет. Формулу в ячейки с аргументами поставить получилось, однако возникла проблема- исходная таблица постоянно растет, а вот формула, как вышло у меня, этого не учитывает, т.е.берет только заложенный в ней диапазон. Как учесть растущий диапазон на другом листе?..И еще один вопрос по такой вставке- Если данные для отчета находятся в соседних столбцах (январь,февраль, март и т.д.), то у меня вышло вставить ОДИНАКОВУЮ формулу для каждой колонки путем увеличения диапазона. А вот как быть, если одинаковая формула должна встать в несколько РАЗДЕЛЕННЫХ между собой колонках? Пробовал писать диапазоны через запятую, но ругается...Спасибо
Добрый день Уважаемые форумчане.. Подскажите пожалуйста как записать формулу "суммеслимн" в макрос. По-сути из листа "отсюда" собираются уникальные фамилии в лист "сюда", затем создается отчет. Формулу в ячейки с аргументами поставить получилось, однако возникла проблема- исходная таблица постоянно растет, а вот формула, как вышло у меня, этого не учитывает, т.е.берет только заложенный в ней диапазон. Как учесть растущий диапазон на другом листе?..И еще один вопрос по такой вставке- Если данные для отчета находятся в соседних столбцах (январь,февраль, март и т.д.), то у меня вышло вставить ОДИНАКОВУЮ формулу для каждой колонки путем увеличения диапазона. А вот как быть, если одинаковая формула должна встать в несколько РАЗДЕЛЕННЫХ между собой колонках? Пробовал писать диапазоны через запятую, но ругается...Спасибоalex808
китин, В данном примере она конечно поможет, НО в итоговую таблицу подгружаются данные еще и из других таблиц. Кроме того сами исходные таблицы формируются из нескольких, затем какие-то из них вообще сращиваются и после консолидации делаются дополнительные расчеты....Вообщем есть задача сделать не только отчеты, а еще загрузить систему некоторыми управляющими функциями... Так что нужен именно макрос..Спасибо за внимание к моему посту
китин, В данном примере она конечно поможет, НО в итоговую таблицу подгружаются данные еще и из других таблиц. Кроме того сами исходные таблицы формируются из нескольких, затем какие-то из них вообще сращиваются и после консолидации делаются дополнительные расчеты....Вообщем есть задача сделать не только отчеты, а еще загрузить систему некоторыми управляющими функциями... Так что нужен именно макрос..Спасибо за внимание к моему постуalex808
x = Array("январь", "февраль", "март", "апрель", "май", "июнь", "июль", "август", "сентябрь", "октябрь", "ноябрь", "декабрь") With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 0 To UBound(x) .Item(x(i)) = i + 2 Next i
x = Sheets("отсюда").Range("A1").CurrentRegion.Value ReDim y(1 To UBound(x, 1), 1 To 13): cl = 1
For i = 2 To UBound(x) If .Exists(x(i, 1)) Then 'ФИО продавца rw = .Item(x(i, 1)) Else k = k + 1: .Item(x(i, 1)) = k y(k, 1) = x(i, 1): rw = k End If
If .Exists(x(i, 3)) Then cl = .Item(x(i, 3)) Else n = n + 1: .Item(x(i, 3)) = n: cl = n End If y(rw, cl) = y(rw, cl) + x(i, 2) Next i End With
With Sheets("сюда") .Range("A3").CurrentRegion.Offset(2).ClearContents .Range("A3").Resize(k, UBound(y, 2)).Value = y() .Activate End With End Sub
[/vba]
укеуке - похоже, самый удачливый продавец
может, как-то вот так?:
[vba]
Код
Sub ertert() Dim x, y(), i&, k&, n&, rw&, cl&
x = Array("январь", "февраль", "март", "апрель", "май", "июнь", "июль", "август", "сентябрь", "октябрь", "ноябрь", "декабрь") With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 0 To UBound(x) .Item(x(i)) = i + 2 Next i
x = Sheets("отсюда").Range("A1").CurrentRegion.Value ReDim y(1 To UBound(x, 1), 1 To 13): cl = 1
For i = 2 To UBound(x) If .Exists(x(i, 1)) Then 'ФИО продавца rw = .Item(x(i, 1)) Else k = k + 1: .Item(x(i, 1)) = k y(k, 1) = x(i, 1): rw = k End If
If .Exists(x(i, 3)) Then cl = .Item(x(i, 3)) Else n = n + 1: .Item(x(i, 3)) = n: cl = n End If y(rw, cl) = y(rw, cl) + x(i, 2) Next i End With
With Sheets("сюда") .Range("A3").CurrentRegion.Offset(2).ClearContents .Range("A3").Resize(k, UBound(y, 2)).Value = y() .Activate End With End Sub
nilem, Спасибо большое! Это волшебно..Работает. Даже успел вставить еще более удачливого продавца. Буду разбираться в коде, ибо у меня пока уровень очень низкий- только вставками формул промышляю...попробую разобраться.Спасибо!
nilem, Спасибо большое! Это волшебно..Работает. Даже успел вставить еще более удачливого продавца. Буду разбираться в коде, ибо у меня пока уровень очень низкий- только вставками формул промышляю...попробую разобраться.Спасибо!alex808
nilem, Простите, а что нужно делать, чтобы код еще и год учитывал? Я понял, что выделен Х по строке месяцы и берется У по фамилиям, но как я понимаю , при принятии во внимание параметра "год" необходим еще один Х?..Но как тогда изменится код?..Я еще в присвоении разных переменных , как и во взрослых кодах не бум=бум..
nilem, Простите, а что нужно делать, чтобы код еще и год учитывал? Я понял, что выделен Х по строке месяцы и берется У по фамилиям, но как я понимаю , при принятии во внимание параметра "год" необходим еще один Х?..Но как тогда изменится код?..Я еще в присвоении разных переменных , как и во взрослых кодах не бум=бум..alex808
Sub ertert() Dim x, y(), i&, k&, n&, rw&, cl& Dim mn, yr, s$ mn = Array("январь", "февраль", "март", "апрель", "май", "июнь", "июль", "август", "сентябрь", "октябрь", "ноябрь", "декабрь") yr = Array(2015, 2016, 2017) 'можно, например, так: yr = Array(2016, 2017, 2018, 2019) x = Sheets("отсюда").Range("A1").CurrentRegion.Value ReDim y(1 To UBound(x) + 2, 1 To (UBound(mn) + 1) * (UBound(yr) + 1) + 1)
With CreateObject("Scripting.Dictionary") .CompareMode = 1: k = 1 For n = 0 To UBound(yr) 'years For i = 0 To UBound(mn) 'months k = k + 1: .Item(mn(i) & yr(n)) = k '"месяц&год" - номер столбца y(1, k) = yr(n): y(2, k) = mn(i) Next i Next n
cl = 1: k = 2 For i = 2 To UBound(x) If .Exists(x(i, 1)) Then 'ФИО продавца rw = .Item(x(i, 1)) Else k = k + 1: .Item(x(i, 1)) = k y(k, 1) = x(i, 1): rw = k End If
s = x(i, 3) & x(i, 4) '"месяц&год" If .Exists(s) Then cl = .Item(s) End If y(rw, cl) = y(rw, cl) + x(i, 2) Next i End With y(1, 1) = "Уникальное имя продавца"
With Sheets("сюда") .Range("A1").CurrentRegion.ClearContents .Range("A1").Resize(k, UBound(y, 2)).Value = y() .Activate End With End Sub
[/vba]
Вот здесь yr = Array(2015, 2016, 2017) напишите те годы, которые нужны, - за эти и получите отчет.
попробуйте так:
[vba]
Код
Sub ertert() Dim x, y(), i&, k&, n&, rw&, cl& Dim mn, yr, s$ mn = Array("январь", "февраль", "март", "апрель", "май", "июнь", "июль", "август", "сентябрь", "октябрь", "ноябрь", "декабрь") yr = Array(2015, 2016, 2017) 'можно, например, так: yr = Array(2016, 2017, 2018, 2019) x = Sheets("отсюда").Range("A1").CurrentRegion.Value ReDim y(1 To UBound(x) + 2, 1 To (UBound(mn) + 1) * (UBound(yr) + 1) + 1)
With CreateObject("Scripting.Dictionary") .CompareMode = 1: k = 1 For n = 0 To UBound(yr) 'years For i = 0 To UBound(mn) 'months k = k + 1: .Item(mn(i) & yr(n)) = k '"месяц&год" - номер столбца y(1, k) = yr(n): y(2, k) = mn(i) Next i Next n
cl = 1: k = 2 For i = 2 To UBound(x) If .Exists(x(i, 1)) Then 'ФИО продавца rw = .Item(x(i, 1)) Else k = k + 1: .Item(x(i, 1)) = k y(k, 1) = x(i, 1): rw = k End If
s = x(i, 3) & x(i, 4) '"месяц&год" If .Exists(s) Then cl = .Item(s) End If y(rw, cl) = y(rw, cl) + x(i, 2) Next i End With y(1, 1) = "Уникальное имя продавца"
With Sheets("сюда") .Range("A1").CurrentRegion.ClearContents .Range("A1").Resize(k, UBound(y, 2)).Value = y() .Activate End With End Sub
[/vba]
Вот здесь yr = Array(2015, 2016, 2017) напишите те годы, которые нужны, - за эти и получите отчет.nilem