Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сводный отчет через collection с делением по листам - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сводный отчет через collection с делением по листам (Макросы/Sub)
Сводный отчет через collection с делением по листам
ssm Дата: Суббота, 13.06.2020, 12:39 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день,

К продолжению прошлой темы, прошу подсказать что делаю не так при делении данных по листам, привожу готовый макрос, благодарю Hugo, при малом количестве по полю Код работает вроде правильно, но если увеличиваю количество строк до 200 тыс. и условий деления по листам до 10 ( в коде прописано условие "сумма" или "количество", я добавляю еще варианты условий) он перестает отрабатывать, оставляет листы не заполненными.
К сообщению приложен файл: __.xlsm(23.7 Kb)
 
Ответить
СообщениеДобрый день,

К продолжению прошлой темы, прошу подсказать что делаю не так при делении данных по листам, привожу готовый макрос, благодарю Hugo, при малом количестве по полю Код работает вроде правильно, но если увеличиваю количество строк до 200 тыс. и условий деления по листам до 10 ( в коде прописано условие "сумма" или "количество", я добавляю еще варианты условий) он перестает отрабатывать, оставляет листы не заполненными.

Автор - ssm
Дата добавления - 13.06.2020 в 12:39
Hugo Дата: Суббота, 13.06.2020, 13:32 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3070
Репутация: 662 ±
Замечаний: 0% ±

Добрый день.
Явно что-то делаете не так.
Ибо если в существующем коде переставить строки вот так:

[vba]
Код

        a = Sheets("сумма").Range("A5").CurrentRegion.Rows(1).Resize(2).Value
        ReDim b(1 To col.Count, 1 To 6)
        For i = 1 To col.Count
            b(i, 1) = col(i)
            For ii = 2 To UBound(a, 2)
                t = b(i, 1) & "|" & a(2, ii) & "|" & a(1, ii)
                b(i, ii) = .Item(t)
            Next
        Next
        Sheets("сумма").Range("A6").Resize(UBound(b), UBound(b, 2)) = b

        a = Sheets("количество").Range("A5").CurrentRegion.Rows(1).Resize(2).Value
        ReDim b1(1 To col.Count, 1 To 6)
        For i = 1 To col.Count
            b1(i, 1) = col(i)
            For ii = 2 To UBound(a, 2)
                t = b1(i, 1) & "|" & a(2, ii) & "|" & a(1, ii)
                b1(i, ii) = .Item(t)
            Next
        Next
        Sheets("количество").Range("A6").Resize(UBound(b1), UBound(b1, 2)) = b1
[/vba]

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


excel@nxt.ru
webmoney: E265281470651 R418926282008 Z422237915069
 
Ответить
СообщениеДобрый день.
Явно что-то делаете не так.
Ибо если в существующем коде переставить строки вот так:

[vba]
Код

        a = Sheets("сумма").Range("A5").CurrentRegion.Rows(1).Resize(2).Value
        ReDim b(1 To col.Count, 1 To 6)
        For i = 1 To col.Count
            b(i, 1) = col(i)
            For ii = 2 To UBound(a, 2)
                t = b(i, 1) & "|" & a(2, ii) & "|" & a(1, ii)
                b(i, ii) = .Item(t)
            Next
        Next
        Sheets("сумма").Range("A6").Resize(UBound(b), UBound(b, 2)) = b

        a = Sheets("количество").Range("A5").CurrentRegion.Rows(1).Resize(2).Value
        ReDim b1(1 To col.Count, 1 To 6)
        For i = 1 To col.Count
            b1(i, 1) = col(i)
            For ii = 2 To UBound(a, 2)
                t = b1(i, 1) & "|" & a(2, ii) & "|" & a(1, ii)
                b1(i, ii) = .Item(t)
            Next
        Next
        Sheets("количество").Range("A6").Resize(UBound(b1), UBound(b1, 2)) = b1
[/vba]

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

Автор - Hugo
Дата добавления - 13.06.2020 в 13:32
Hugo Дата: Суббота, 13.06.2020, 13:38 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3070
Репутация: 662 ±
Замечаний: 0% ±

Вот например:
[vba]
Код


Option Explicit

Sub кол()
    Dim a(), i&, ii&, t$, col As New Collection
    Dim dic As Object
    Set dic = CreateObject("scripting.dictionary")
    With dic
        .comparemode = 1

        a = Sheets("данные").Range("A1").CurrentRegion.Value

        On Error Resume Next
        For i = 2 To UBound(a)
            col.Add a(i, 1), Trim(a(i, 1))
            t = a(i, 1) & "|" & a(i, 4) & "|" & "сумма"
            .Item(t) = .Item(t) + a(i, 3)
            t = a(i, 1) & "|" & a(i, 4) & "|" & "количество"
            .Item(t) = .Item(t) + a(i, 2)
        Next
        On Error GoTo 0

        подпроцедура "сумма", col, dic
        подпроцедура "количество", col, dic

    End With
End Sub

Private Sub подпроцедура(лист, col, dic As Object)
    Dim a, b, i&, ii&, t$

    Sheets(лист).Range("A6:M13").ClearContents
    a = Sheets(лист).Range("A5").CurrentRegion.Rows(1).Resize(2).Value
    ReDim b(1 To col.Count, 1 To 6)
    For i = 1 To col.Count
        b(i, 1) = col(i)
        For ii = 2 To UBound(a, 2)
            t = b(i, 1) & "|" & a(2, ii) & "|" & a(1, ii)
            b(i, ii) = dic.Item(t)
        Next
    Next
    Sheets(лист).Range("A6").Resize(UBound(b), UBound(b, 2)) = b

End Sub

[/vba]
И даже можно имена листов загнать в массив и перебирать его - будет ещё проще.


excel@nxt.ru
webmoney: E265281470651 R418926282008 Z422237915069


Сообщение отредактировал Hugo - Суббота, 13.06.2020, 13:40
 
Ответить
СообщениеВот например:
[vba]
Код


Option Explicit

Sub кол()
    Dim a(), i&, ii&, t$, col As New Collection
    Dim dic As Object
    Set dic = CreateObject("scripting.dictionary")
    With dic
        .comparemode = 1

        a = Sheets("данные").Range("A1").CurrentRegion.Value

        On Error Resume Next
        For i = 2 To UBound(a)
            col.Add a(i, 1), Trim(a(i, 1))
            t = a(i, 1) & "|" & a(i, 4) & "|" & "сумма"
            .Item(t) = .Item(t) + a(i, 3)
            t = a(i, 1) & "|" & a(i, 4) & "|" & "количество"
            .Item(t) = .Item(t) + a(i, 2)
        Next
        On Error GoTo 0

        подпроцедура "сумма", col, dic
        подпроцедура "количество", col, dic

    End With
End Sub

Private Sub подпроцедура(лист, col, dic As Object)
    Dim a, b, i&, ii&, t$

    Sheets(лист).Range("A6:M13").ClearContents
    a = Sheets(лист).Range("A5").CurrentRegion.Rows(1).Resize(2).Value
    ReDim b(1 To col.Count, 1 To 6)
    For i = 1 To col.Count
        b(i, 1) = col(i)
        For ii = 2 To UBound(a, 2)
            t = b(i, 1) & "|" & a(2, ii) & "|" & a(1, ii)
            b(i, ii) = dic.Item(t)
        Next
    Next
    Sheets(лист).Range("A6").Resize(UBound(b), UBound(b, 2)) = b

End Sub

[/vba]
И даже можно имена листов загнать в массив и перебирать его - будет ещё проще.

Автор - Hugo
Дата добавления - 13.06.2020 в 13:38
ssm Дата: Суббота, 13.06.2020, 13:38 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Hugo, т.е. подп процедура это:
For i = 1 To ...
Sh(i)...
Next i
?
 
Ответить
СообщениеHugo, т.е. подп процедура это:
For i = 1 To ...
Sh(i)...
Next i
?

Автор - ssm
Дата добавления - 13.06.2020 в 13:38
ssm Дата: Суббота, 13.06.2020, 17:23 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Hugo, спасибо большое, разобрался hands
 
Ответить
СообщениеHugo, спасибо большое, разобрался hands

Автор - ssm
Дата добавления - 13.06.2020 в 17:23
Hugo Дата: Воскресенье, 14.06.2020, 13:55 | Сообщение № 6
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3070
Репутация: 662 ±
Замечаний: 0% ±

Не, подпроцедура это то что я так и назвал. Может не совсем классическое определение...
Добавил цикл по названиям листов.


excel@nxt.ru
webmoney: E265281470651 R418926282008 Z422237915069


Сообщение отредактировал Hugo - Воскресенье, 14.06.2020, 14:04
 
Ответить
СообщениеНе, подпроцедура это то что я так и назвал. Может не совсем классическое определение...
Добавил цикл по названиям листов.

Автор - Hugo
Дата добавления - 14.06.2020 в 13:55
Hugo Дата: Воскресенье, 14.06.2020, 14:03 | Сообщение № 7
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3070
Репутация: 662 ±
Замечаний: 0% ±

Итоговый вариант, подправил массив arr


Только вот на практике диапазон "A6:M13" думаю нужно корректировать динамически. Можно привязываться к тому же Sheets(лист).Range("A5").CurrentRegion - изменил код.


excel@nxt.ru
webmoney: E265281470651 R418926282008 Z422237915069


Сообщение отредактировал Hugo - Воскресенье, 14.06.2020, 17:58
 
Ответить
СообщениеИтоговый вариант, подправил массив arr


Только вот на практике диапазон "A6:M13" думаю нужно корректировать динамически. Можно привязываться к тому же Sheets(лист).Range("A5").CurrentRegion - изменил код.

Автор - Hugo
Дата добавления - 14.06.2020 в 14:03
ssm Дата: Понедельник, 15.06.2020, 07:26 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Hugo, спасибо большое, за все варианты:). остался маленький вопросик, но создам новую тему, правила форума:)
 
Ответить
СообщениеHugo, спасибо большое, за все варианты:). остался маленький вопросик, но создам новую тему, правила форума:)

Автор - ssm
Дата добавления - 15.06.2020 в 07:26
ssm Дата: Понедельник, 15.06.2020, 07:44 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Hugo, ваш последний код с листами в цикле выкидывает ошибку вот на эту строку:
[vba]
Код
.Rows(3).Resize(.Rows.Count - 2).ClearContents
[/vba]
я заменил вот на это и заработало:
[vba]
Код
.Rows(3).Resize(.Rows.Count - 1).ClearContents
[/vba]
Только я не понял зачем это конструкция вообще нужна?


Сообщение отредактировал ssm - Понедельник, 15.06.2020, 17:41
 
Ответить
СообщениеHugo, ваш последний код с листами в цикле выкидывает ошибку вот на эту строку:
[vba]
Код
.Rows(3).Resize(.Rows.Count - 2).ClearContents
[/vba]
я заменил вот на это и заработало:
[vba]
Код
.Rows(3).Resize(.Rows.Count - 1).ClearContents
[/vba]
Только я не понял зачем это конструкция вообще нужна?

Автор - ssm
Дата добавления - 15.06.2020 в 07:44
Hugo Дата: Понедельник, 15.06.2020, 17:00 | Сообщение № 10
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3070
Репутация: 662 ±
Замечаний: 0% ±

Да, чуть ошибся, не потестил на пустом листе...
А зачем оно нужно - ну ведь у Вас в коде есть очистка диапазона. Но не привязана к данным - вдруг их там будет больше?


excel@nxt.ru
webmoney: E265281470651 R418926282008 Z422237915069
 
Ответить
СообщениеДа, чуть ошибся, не потестил на пустом листе...
А зачем оно нужно - ну ведь у Вас в коде есть очистка диапазона. Но не привязана к данным - вдруг их там будет больше?

Автор - Hugo
Дата добавления - 15.06.2020 в 17:00
Pelena Дата: Понедельник, 15.06.2020, 17:22 | Сообщение № 11
Группа: Админы
Ранг: Местный житель
Сообщений: 16511
Репутация: 3567 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
ssm, оформите строчки кода тегами с помощью кнопки # в режиме правки поста


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
Сообщениеssm, оформите строчки кода тегами с помощью кнопки # в режиме правки поста

Автор - Pelena
Дата добавления - 15.06.2020 в 17:22
ssm Дата: Понедельник, 15.06.2020, 17:24 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, исправлюсь[vba]
Код
.Rows(3).Resize(.Rows.Count - 2).ClearContents
[/vba]
[vba]
Код
.Rows(3).Resize(.Rows.Count - 1).ClearContents
[/vba]
 
Ответить
СообщениеPelena, исправлюсь[vba]
Код
.Rows(3).Resize(.Rows.Count - 2).ClearContents
[/vba]
[vba]
Код
.Rows(3).Resize(.Rows.Count - 1).ClearContents
[/vba]

Автор - ssm
Дата добавления - 15.06.2020 в 17:24
ssm Дата: Понедельник, 15.06.2020, 17:36 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Hugo, а то есть альтернатива кода?:
[vba]
Код
Range(Sheets(1).Cells(11,1),Sheets(1).Cells(10000,p)).ClearContens
[/vba]


Сообщение отредактировал ssm - Понедельник, 15.06.2020, 17:37
 
Ответить
СообщениеHugo, а то есть альтернатива кода?:
[vba]
Код
Range(Sheets(1).Cells(11,1),Sheets(1).Cells(10000,p)).ClearContens
[/vba]

Автор - ssm
Дата добавления - 15.06.2020 в 17:36
Hugo Дата: Понедельник, 15.06.2020, 17:55 | Сообщение № 14
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3070
Репутация: 662 ±
Замечаний: 0% ±

То что постом выше чем не альтернатива?
Ну конечно нужно поменять диапазон и цифры...
А по Вашему куску - без файла сказать нечего.


excel@nxt.ru
webmoney: E265281470651 R418926282008 Z422237915069


Сообщение отредактировал Hugo - Понедельник, 15.06.2020, 17:57
 
Ответить
СообщениеТо что постом выше чем не альтернатива?
Ну конечно нужно поменять диапазон и цифры...
А по Вашему куску - без файла сказать нечего.

Автор - Hugo
Дата добавления - 15.06.2020 в 17:55
ssm Дата: Понедельник, 15.06.2020, 20:15 | Сообщение № 15
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Hugo, я о том что ваш кусок файла так же растягивается на заполненный диапазон данными и очищает его. Просто, я, программированием VBA занимаюсь по необходимости когда совсем прижмет из-за объем данных и формулы уже не справляются:) Только сейчас с вашей помощью начал понимать как работает Resize:) Большое спасибо что вы есть, и есть кто может поделиться опытом.


Сообщение отредактировал ssm - Понедельник, 15.06.2020, 20:16
 
Ответить
СообщениеHugo, я о том что ваш кусок файла так же растягивается на заполненный диапазон данными и очищает его. Просто, я, программированием VBA занимаюсь по необходимости когда совсем прижмет из-за объем данных и формулы уже не справляются:) Только сейчас с вашей помощью начал понимать как работает Resize:) Большое спасибо что вы есть, и есть кто может поделиться опытом.

Автор - ssm
Дата добавления - 15.06.2020 в 20:15
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сводный отчет через collection с делением по листам (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2020 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!