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

Вход

Регистрация

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

 

= Мир MS Excel/Формирование отчета при выделении нескольких опций в ListBox - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Формирование отчета при выделении нескольких опций в ListBox (Макросы/Sub)
Формирование отчета при выделении нескольких опций в ListBox
parovoznik Дата: Пятница, 25.01.2019, 13:27 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 283
Репутация: 16 ±
Замечаний: 0% ±

Excel 2007
Добрый день. Имеется таблица реестр .
На основании таблицы можно формировать отчет по Клиенту: выбираем период,клиента (выделена одна опция в Листбоксе) все работает.
Вопрос :а как можно подкорректировать код ,что бы можно было выделять несколько опций и формировать отчет?
При инициализации формы сейчас : [vba]
Код
Me.ListBox1.MultiSelect = fmMultiSelectMulti
[/vba]
В прилагаемом файле на Листе "Карточка" есть вариант как должно быть .
Заранее благодарен.
К сообщению приложен файл: __.xlsm(57.9 Kb)


Сообщение отредактировал parovoznik - Пятница, 25.01.2019, 14:09
 
Ответить
СообщениеДобрый день. Имеется таблица реестр .
На основании таблицы можно формировать отчет по Клиенту: выбираем период,клиента (выделена одна опция в Листбоксе) все работает.
Вопрос :а как можно подкорректировать код ,что бы можно было выделять несколько опций и формировать отчет?
При инициализации формы сейчас : [vba]
Код
Me.ListBox1.MultiSelect = fmMultiSelectMulti
[/vba]
В прилагаемом файле на Листе "Карточка" есть вариант как должно быть .
Заранее благодарен.

Автор - parovoznik
Дата добавления - 25.01.2019 в 13:27
_Boroda_ Дата: Пятница, 25.01.2019, 13:41 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 14125
Репутация: 5696 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Юрий, вот от кого-кого, а от Вас не ожидал. Исправляйте свой пост (кнопочка #)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЮрий, вот от кого-кого, а от Вас не ожидал. Исправляйте свой пост (кнопочка #)

Автор - _Boroda_
Дата добавления - 25.01.2019 в 13:41
parovoznik Дата: Пятница, 25.01.2019, 14:11 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 283
Репутация: 16 ±
Замечаний: 0% ±

Excel 2007
_Boroda_, исправил замечание. А как с кодом, поможете отредактировать? :(
 
Ответить
Сообщение_Boroda_, исправил замечание. А как с кодом, поможете отредактировать? :(

Автор - parovoznik
Дата добавления - 25.01.2019 в 14:11
_Boroda_ Дата: Пятница, 25.01.2019, 14:52 | Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 14125
Репутация: 5696 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
К сожалению сейчас не смогу, у Вас там разбираться нужно, а я на работе сильно занят, на форуме времени хватает только на быстрые решения


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеК сожалению сейчас не смогу, у Вас там разбираться нужно, а я на работе сильно занят, на форуме времени хватает только на быстрые решения

Автор - _Boroda_
Дата добавления - 25.01.2019 в 14:52
parovoznik Дата: Пятница, 25.01.2019, 15:34 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 283
Репутация: 16 ±
Замечаний: 0% ±

Excel 2007
Да, у меня код там есть дополнительный ,но как "прикрутить не знаю".
 
Ответить
СообщениеДа, у меня код там есть дополнительный ,но как "прикрутить не знаю".

Автор - parovoznik
Дата добавления - 25.01.2019 в 15:34
vikttur Дата: Пятница, 25.01.2019, 16:09 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 2895
Репутация: 519 ±
Замечаний: 0% ±

В Call Report передаем массив выбранных значений и их количество.
[vba]
Код
'Кнопка Сформировать
Private Sub ButtonReport_Click()
Dim a(), i As Long, k As Long
'........................................ здесь все, что до строки  Firma = Me.ListBox1.Value
'    Firma = Me.ListBox1.Value

    With ListBox1
        ReDim a(1 To .ListCount)
        
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                k = k + 1: a0(k) = .List(i)
            End If
        Next i
    End With
    
    Call Report(a0, k)
    Unload Me
End Sub
[/vba]
В процедуре циклом по этому массиву
[vba]
Код
Sub Report(a0(), k As Long)
Dim n As Long
'.......................
                If Reestr.Cells(i, 4) <= DateFinish Then
                    For n = 1 To k
                        If Reestr.Cells(i, 6) = a0(n) Then
                             .Cells(LR, 1) = Reestr.Cells(i, 1).Value
'.......................
[/vba]
Только правка по вопросу. По хорошему - всю обработку перенести в массивы (к листу обращаться при первичном чтении и для выгрузки).


Сообщение отредактировал vikttur - Пятница, 25.01.2019, 16:14
 
Ответить
СообщениеВ Call Report передаем массив выбранных значений и их количество.
[vba]
Код
'Кнопка Сформировать
Private Sub ButtonReport_Click()
Dim a(), i As Long, k As Long
'........................................ здесь все, что до строки  Firma = Me.ListBox1.Value
'    Firma = Me.ListBox1.Value

    With ListBox1
        ReDim a(1 To .ListCount)
        
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                k = k + 1: a0(k) = .List(i)
            End If
        Next i
    End With
    
    Call Report(a0, k)
    Unload Me
End Sub
[/vba]
В процедуре циклом по этому массиву
[vba]
Код
Sub Report(a0(), k As Long)
Dim n As Long
'.......................
                If Reestr.Cells(i, 4) <= DateFinish Then
                    For n = 1 To k
                        If Reestr.Cells(i, 6) = a0(n) Then
                             .Cells(LR, 1) = Reestr.Cells(i, 1).Value
'.......................
[/vba]
Только правка по вопросу. По хорошему - всю обработку перенести в массивы (к листу обращаться при первичном чтении и для выгрузки).

Автор - vikttur
Дата добавления - 25.01.2019 в 16:09
parovoznik Дата: Пятница, 25.01.2019, 16:41 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 283
Репутация: 16 ±
Замечаний: 0% ±

Excel 2007
vikttur, спасибо за код . Выдает ошибку в этом блоке:"Функция не определена"
[vba]
Код
With ListBox1
        ReDim a(1 To .ListCount)
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                k = k + 1: [b]a0(k) [/b]= .List(i)
            End If
        Next i
    End With
[/vba]
К сообщению приложен файл: ___2.xlsm(66.5 Kb)
 
Ответить
Сообщениеvikttur, спасибо за код . Выдает ошибку в этом блоке:"Функция не определена"
[vba]
Код
With ListBox1
        ReDim a(1 To .ListCount)
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                k = k + 1: [b]a0(k) [/b]= .List(i)
            End If
        Next i
    End With
[/vba]

Автор - parovoznik
Дата добавления - 25.01.2019 в 16:41
RAN Дата: Пятница, 25.01.2019, 16:57 | Сообщение № 8
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4913
Репутация: 981 ±
Замечаний: 0% ±

2010
Тут и без мелкоскопа видно, что 0 либо зря приписан, либо не везде дописан.


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеТут и без мелкоскопа видно, что 0 либо зря приписан, либо не везде дописан.

Автор - RAN
Дата добавления - 25.01.2019 в 16:57
vikttur Дата: Пятница, 25.01.2019, 17:03 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 2895
Репутация: 519 ±
Замечаний: 0% ±

Моя ошибка.
Dim a()
а дальше a0()
Сделайте везде одинаково.

В исполняемой процедуре не закыли цикл по n
Next n
 
Ответить
СообщениеМоя ошибка.
Dim a()
а дальше a0()
Сделайте везде одинаково.

В исполняемой процедуре не закыли цикл по n
Next n

Автор - vikttur
Дата добавления - 25.01.2019 в 17:03
parovoznik Дата: Пятница, 25.01.2019, 17:37 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 283
Репутация: 16 ±
Замечаний: 0% ±

Excel 2007
vikttur, все исправил ,но выдает ошибку : compile error
Вот весь код :
[vba]
Код
Sub Report(a0(), k As Long)
Dim n As Long
Dim i As Long, LastRow As Long, LR As Long

LR = 5 ' Указали, что первая свободная строка для нового отчёта будет =5
With Card 'Применительно ко второму листу
        LastRow = .Cells(Rows.Count, 1).End(xlUp).row 'Нашли последнюю строку на втором листе
        Range(.Cells(5, 1), .Cells(LastRow + 1, 4)).Clear 'Очистили диапазон отчета полностью
        .Cells(2, 2).ClearContents 'Очистили ЗНАЧЕНИЯ в шапке отчета
        .Cells(2, 2) = "Отчет с " & DateStart & " по " & DateFinish 'Заполнили заголовок отчета
        .Cells(3, 2) = "Карточка:  " & Firma
        LastRow = Cells(Rows.Count, 1).End(xlUp).row 'Нашли последнюю строку на первом листе
        For i = 3 To LastRow 'Начали цикл (на первом листе) со строки № 3 по последнюю
            If Reestr.Cells(i, 4) >= DateStart Then
                 If Reestr.Cells(i, 4) <= DateFinish Then
                    For n = 1 To k
                        If Reestr.Cells(i, 6) = a0(n) Then
                            .Cells(LR, 1) = Reestr.Cells(i, 1).Value
                            .Cells(LR, 2) = Reestr.Cells(i, 4).Value
                            .Cells(LR, 3) = Reestr.Cells(i, 6).Value
                            .Cells(LR, 4) = Reestr.Cells(i, 7).Value
                           LR = LR + 1 'Увеличили на единичку номер первой свободной строки отчета
                        End If
                  End If
            End If
                Next n
         Next i
        'Заполним подвал отчета
        .Cells(LR, 1) = "Итого:"
        .Cells(LR, 4) = Application.WorksheetFunction.Sum(Range(.Cells(5, 4), .Cells(LR - 1, 4))) 'Посчитали сумму отчета
        Range(.Cells(5, 1), .Cells(LR, 4)).Borders.LineStyle = xlContinuous 'Сделали обрамление ячеек
End With
    If LR = 5 Then MsgBox "По данными критериям данных не найдено!", 64, "Сообщение"
End Sub
[/vba]
К сообщению приложен файл: 2477274.xlsm(68.7 Kb)


Сообщение отредактировал parovoznik - Пятница, 25.01.2019, 17:38
 
Ответить
Сообщениеvikttur, все исправил ,но выдает ошибку : compile error
Вот весь код :
[vba]
Код
Sub Report(a0(), k As Long)
Dim n As Long
Dim i As Long, LastRow As Long, LR As Long

LR = 5 ' Указали, что первая свободная строка для нового отчёта будет =5
With Card 'Применительно ко второму листу
        LastRow = .Cells(Rows.Count, 1).End(xlUp).row 'Нашли последнюю строку на втором листе
        Range(.Cells(5, 1), .Cells(LastRow + 1, 4)).Clear 'Очистили диапазон отчета полностью
        .Cells(2, 2).ClearContents 'Очистили ЗНАЧЕНИЯ в шапке отчета
        .Cells(2, 2) = "Отчет с " & DateStart & " по " & DateFinish 'Заполнили заголовок отчета
        .Cells(3, 2) = "Карточка:  " & Firma
        LastRow = Cells(Rows.Count, 1).End(xlUp).row 'Нашли последнюю строку на первом листе
        For i = 3 To LastRow 'Начали цикл (на первом листе) со строки № 3 по последнюю
            If Reestr.Cells(i, 4) >= DateStart Then
                 If Reestr.Cells(i, 4) <= DateFinish Then
                    For n = 1 To k
                        If Reestr.Cells(i, 6) = a0(n) Then
                            .Cells(LR, 1) = Reestr.Cells(i, 1).Value
                            .Cells(LR, 2) = Reestr.Cells(i, 4).Value
                            .Cells(LR, 3) = Reestr.Cells(i, 6).Value
                            .Cells(LR, 4) = Reestr.Cells(i, 7).Value
                           LR = LR + 1 'Увеличили на единичку номер первой свободной строки отчета
                        End If
                  End If
            End If
                Next n
         Next i
        'Заполним подвал отчета
        .Cells(LR, 1) = "Итого:"
        .Cells(LR, 4) = Application.WorksheetFunction.Sum(Range(.Cells(5, 4), .Cells(LR - 1, 4))) 'Посчитали сумму отчета
        Range(.Cells(5, 1), .Cells(LR, 4)).Borders.LineStyle = xlContinuous 'Сделали обрамление ячеек
End With
    If LR = 5 Then MsgBox "По данными критериям данных не найдено!", 64, "Сообщение"
End Sub
[/vba]

Автор - parovoznik
Дата добавления - 25.01.2019 в 17:37
Pelena Дата: Пятница, 25.01.2019, 17:46 | Сообщение № 11
Группа: Админы
Ранг: Местный житель
Сообщений: 13660
Репутация: 3004 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Next n должен стоять после первого End If


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеNext n должен стоять после первого End If

Автор - Pelena
Дата добавления - 25.01.2019 в 17:46
parovoznik Дата: Пятница, 25.01.2019, 21:53 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 283
Репутация: 16 ±
Замечаний: 0% ±

Excel 2007
Только правка по вопросу. По хорошему - всю обработку перенести в массивы (к листу обращаться при первичном чтении и для выгрузки).


vikttur,если есть возможность прокомментировать использования кода и как это можно воплотить в моем коде. Я на протяжении многих лет пользовался этим кодом и вот пришлось доработать,а оказывается есть еще варианты.
Дякую. hands
Pelena , благодарю за помощь. hands
 
Ответить
Сообщение
Только правка по вопросу. По хорошему - всю обработку перенести в массивы (к листу обращаться при первичном чтении и для выгрузки).


vikttur,если есть возможность прокомментировать использования кода и как это можно воплотить в моем коде. Я на протяжении многих лет пользовался этим кодом и вот пришлось доработать,а оказывается есть еще варианты.
Дякую. hands
Pelena , благодарю за помощь. hands

Автор - parovoznik
Дата добавления - 25.01.2019 в 21:53
vikttur Дата: Пятница, 25.01.2019, 23:59 | Сообщение № 13
Группа: Друзья
Ранг: Старожил
Сообщений: 2895
Репутация: 519 ±
Замечаний: 0% ±

Цитата
прокомментировать... и как это можно воплотить в моем коде

Читайте о массивах.
Коротко.
Работа с объектами листа медленная. Данные с листа записываются в массив, в процессе обрабтки результат записывается во второй массив (или в этот же, в 2-3 других - зависит от задачи). После обработки данные одним действием выгружаются на лист.
Этим достигается многократное увеличение скорости работы макроса.
 
Ответить
Сообщение
Цитата
прокомментировать... и как это можно воплотить в моем коде

Читайте о массивах.
Коротко.
Работа с объектами листа медленная. Данные с листа записываются в массив, в процессе обрабтки результат записывается во второй массив (или в этот же, в 2-3 других - зависит от задачи). После обработки данные одним действием выгружаются на лист.
Этим достигается многократное увеличение скорости работы макроса.

Автор - vikttur
Дата добавления - 25.01.2019 в 23:59
parovoznik Дата: Суббота, 26.01.2019, 00:36 | Сообщение № 14
Группа: Проверенные
Ранг: Обитатель
Сообщений: 283
Репутация: 16 ±
Замечаний: 0% ±

Excel 2007
Спасибо ,но пока это тяжело понять,как это воплотить
 
Ответить
СообщениеСпасибо ,но пока это тяжело понять,как это воплотить

Автор - parovoznik
Дата добавления - 26.01.2019 в 00:36
vikttur Дата: Суббота, 26.01.2019, 01:21 | Сообщение № 15
Группа: Друзья
Ранг: Старожил
Сообщений: 2895
Репутация: 519 ±
Замечаний: 0% ±

На подготовку "примера" требуется время. Может, у кого будет свободное...
 
Ответить
СообщениеНа подготовку "примера" требуется время. Может, у кого будет свободное...

Автор - vikttur
Дата добавления - 26.01.2019 в 01:21
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Формирование отчета при выделении нескольких опций в ListBox (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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