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

Вход

Регистрация

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

 

= Мир MS Excel/Отображение результат отбора с заданным порядком - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Отображение результат отбора с заданным порядком (Макросы/Sub)
Отображение результат отбора с заданным порядком
AVI Дата: Среда, 17.10.2018, 07:44 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 503
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
Добрый день!
Мне нужно, что бы из таблицы Перечень_накл в столбец F перенеслись названия, которые соответствуют периоду, указанному в ячейке D1. Причем, перенеслись с учетом пордяка, который отражен в диапазоне B2:B15
В столбцах I и j отражены результаты, которые должны получиться для сентября и октября
К сообщению приложен файл: _Microsoft_Exce.xlsm(9.8 Kb)
 
Ответить
СообщениеДобрый день!
Мне нужно, что бы из таблицы Перечень_накл в столбец F перенеслись названия, которые соответствуют периоду, указанному в ячейке D1. Причем, перенеслись с учетом пордяка, который отражен в диапазоне B2:B15
В столбцах I и j отражены результаты, которые должны получиться для сентября и октября

Автор - AVI
Дата добавления - 17.10.2018 в 07:44
_Boroda_ Дата: Среда, 17.10.2018, 11:34 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15574
Репутация: 6075 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Вроде вот так работает
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    Application.Calculation = 3
    d0_ = Cells(2, 4)
    If Not IsDate(d0_) Then Exit Sub
    d_ = Format(d0_, "m\/d\/yyyy")
    rd_ = Cells(Rows.Count, 4).End(3).Row
    If rd_ > 2 Then
        Cells(3, 4).Resize(rd_).ClearContents
    End If
    With ActiveSheet
        With .ListObjects("Перечень_накл").Range
            .AutoFilter Field:=2, Operator:=xlFilterValues, Criteria2:=Array(1, d_)
            .Offset(1).Columns(1).SpecialCells(xlCellTypeVisible).Copy Cells(3, 4)
            .AutoFilter Field:=2
        End With
        rd_ = Cells(Rows.Count, 4).End(3).Row
        If rd_ > 2 Then
            Application.AddCustomList ListArray:=Range("B3:B15")
            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=Range("D3:D" & rd_), CustomOrder:=Application.CustomListCount
                .SetRange Range("D2:D" & rd_)
                .Apply
            End With
            Application.DeleteCustomList ListNum:=Application.CustomListCount
        End If
    End With
    Application.Calculation = 1
    Application.ScreenUpdating = 1
End Sub
[/vba]
Файл не прикладываю - Excel вылетел, файл не сохранился, макрос восстановил по памяти (кстати, проверьте - мог где-нибудь накосячить)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеВроде вот так работает
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    Application.Calculation = 3
    d0_ = Cells(2, 4)
    If Not IsDate(d0_) Then Exit Sub
    d_ = Format(d0_, "m\/d\/yyyy")
    rd_ = Cells(Rows.Count, 4).End(3).Row
    If rd_ > 2 Then
        Cells(3, 4).Resize(rd_).ClearContents
    End If
    With ActiveSheet
        With .ListObjects("Перечень_накл").Range
            .AutoFilter Field:=2, Operator:=xlFilterValues, Criteria2:=Array(1, d_)
            .Offset(1).Columns(1).SpecialCells(xlCellTypeVisible).Copy Cells(3, 4)
            .AutoFilter Field:=2
        End With
        rd_ = Cells(Rows.Count, 4).End(3).Row
        If rd_ > 2 Then
            Application.AddCustomList ListArray:=Range("B3:B15")
            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=Range("D3:D" & rd_), CustomOrder:=Application.CustomListCount
                .SetRange Range("D2:D" & rd_)
                .Apply
            End With
            Application.DeleteCustomList ListNum:=Application.CustomListCount
        End If
    End With
    Application.Calculation = 1
    Application.ScreenUpdating = 1
End Sub
[/vba]
Файл не прикладываю - Excel вылетел, файл не сохранился, макрос восстановил по памяти (кстати, проверьте - мог где-нибудь накосячить)

Автор - _Boroda_
Дата добавления - 17.10.2018 в 11:34
AVI Дата: Среда, 17.10.2018, 12:48 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 503
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, Не работает. Я пытался подправить как мог, но все равно не работает

[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    Application.Calculation = 3
    d0_ = Cells(2, 4)
    If Not IsDate(d0_) Then Exit Sub
    d_ = Format(d0_, "m\/d\/yyyy")
    rd_ = Cells(Rows.Count, 4).End(3).Row
    If rd_ > 2 Then
        Cells(3, 4).Resize(rd_).ClearContents
    End If
    With ActiveSheet
        With .ListObjects("Ïåðå÷åíü_íàêë").Range
            .AutoFilter Field:=2, Operator:=xlFilterValues, Criteria2:=Array(1, d_)
            .Offset(1).Columns(1).SpecialCells(xlCellTypeVisible).Copy Cells(3, 4)
            .AutoFilter Field:=2
        End With
        rd_ = Cells(Rows.Count, 4).End(3).Row
        If rd_ > 2 Then
            Application.AddCustomList ListArray:=Range("B3:B15")
            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=Range("F2:F" & rd_), CustomOrder:=Application.CustomListCount
                .SetRange Range("F2:F" & rd_)
                .Apply
            End With
            Application.DeleteCustomList ListNum:=Application.CustomListCount
        End If
    End With
    Application.Calculation = 1
    Application.ScreenUpdating = 1
End Sub
[/vba]
К сообщению приложен файл: 0794228.xlsm(14.5 Kb)
 
Ответить
Сообщение_Boroda_, Не работает. Я пытался подправить как мог, но все равно не работает

[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    Application.Calculation = 3
    d0_ = Cells(2, 4)
    If Not IsDate(d0_) Then Exit Sub
    d_ = Format(d0_, "m\/d\/yyyy")
    rd_ = Cells(Rows.Count, 4).End(3).Row
    If rd_ > 2 Then
        Cells(3, 4).Resize(rd_).ClearContents
    End If
    With ActiveSheet
        With .ListObjects("Ïåðå÷åíü_íàêë").Range
            .AutoFilter Field:=2, Operator:=xlFilterValues, Criteria2:=Array(1, d_)
            .Offset(1).Columns(1).SpecialCells(xlCellTypeVisible).Copy Cells(3, 4)
            .AutoFilter Field:=2
        End With
        rd_ = Cells(Rows.Count, 4).End(3).Row
        If rd_ > 2 Then
            Application.AddCustomList ListArray:=Range("B3:B15")
            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=Range("F2:F" & rd_), CustomOrder:=Application.CustomListCount
                .SetRange Range("F2:F" & rd_)
                .Apply
            End With
            Application.DeleteCustomList ListNum:=Application.CustomListCount
        End If
    End With
    Application.Calculation = 1
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - AVI
Дата добавления - 17.10.2018 в 12:48
_Boroda_ Дата: Среда, 17.10.2018, 13:07 | Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15574
Репутация: 6075 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Да, забыл строку с Header. Ну тогда и диапазон перепишу с 3-й строки
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    Application.Calculation = 3
    d0_ = Cells(2, 4)
    If Not IsDate(d0_) Then Exit Sub
    d_ = Format(d0_, "m\/d\/yyyy")
    rd_ = Cells(Rows.Count, 4).End(3).Row
    If rd_ > 2 Then
        Cells(3, 4).Resize(rd_).ClearContents
    End If
    With ActiveSheet
        With .ListObjects("Перечень_накл").Range
            .AutoFilter Field:=2, Operator:=xlFilterValues, Criteria2:=Array(1, d_)
            .Offset(1).Columns(1).SpecialCells(xlCellTypeVisible).Copy Cells(3, 4)
            .AutoFilter Field:=2
        End With
        rd_ = Cells(Rows.Count, 4).End(3).Row
        If rd_ > 2 Then
            Application.AddCustomList ListArray:=Range("B3:B15")
            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=Range("D3:D" & rd_), CustomOrder:=Application.CustomListCount
                .SetRange Range("D3:D" & rd_)
                .Header = xlGuess
                .Apply
            End With
            Application.DeleteCustomList ListNum:=Application.CustomListCount
        End If
    End With
    Application.Calculation = 1
    Application.ScreenUpdating = 1
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеДа, забыл строку с Header. Ну тогда и диапазон перепишу с 3-й строки
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    Application.Calculation = 3
    d0_ = Cells(2, 4)
    If Not IsDate(d0_) Then Exit Sub
    d_ = Format(d0_, "m\/d\/yyyy")
    rd_ = Cells(Rows.Count, 4).End(3).Row
    If rd_ > 2 Then
        Cells(3, 4).Resize(rd_).ClearContents
    End If
    With ActiveSheet
        With .ListObjects("Перечень_накл").Range
            .AutoFilter Field:=2, Operator:=xlFilterValues, Criteria2:=Array(1, d_)
            .Offset(1).Columns(1).SpecialCells(xlCellTypeVisible).Copy Cells(3, 4)
            .AutoFilter Field:=2
        End With
        rd_ = Cells(Rows.Count, 4).End(3).Row
        If rd_ > 2 Then
            Application.AddCustomList ListArray:=Range("B3:B15")
            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=Range("D3:D" & rd_), CustomOrder:=Application.CustomListCount
                .SetRange Range("D3:D" & rd_)
                .Header = xlGuess
                .Apply
            End With
            Application.DeleteCustomList ListNum:=Application.CustomListCount
        End If
    End With
    Application.Calculation = 1
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 17.10.2018 в 13:07
AVI Дата: Среда, 17.10.2018, 14:07 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 503
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, что-то не то...
Если дату поменять на октябрь то спирт "утекает" низ.
И если после работы макроса нажать на дискетку, то файл просто вылетает.
((
К сообщению приложен файл: 0754424.xlsm(14.5 Kb)
 
Ответить
Сообщение_Boroda_, что-то не то...
Если дату поменять на октябрь то спирт "утекает" низ.
И если после работы макроса нажать на дискетку, то файл просто вылетает.
((

Автор - AVI
Дата добавления - 17.10.2018 в 14:07
_Boroda_ Дата: Среда, 17.10.2018, 15:25 | Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15574
Репутация: 6075 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Ага, и у меня вылетает. Думал, что это так моя машинка своё "фи" выражает, ан нет.
Ну ладно, все равно создание пользовательских списков сортировки дело неблагодарное
По-другому переделал
К сообщению приложен файл: 0754424_2.xlsm(19.2 Kb)


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

Автор - _Boroda_
Дата добавления - 17.10.2018 в 15:25
AVI Дата: Среда, 17.10.2018, 16:37 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 503
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, В октябре спирт опять уехал вниз
 
Ответить
Сообщение_Boroda_, В октябре спирт опять уехал вниз

Автор - AVI
Дата добавления - 17.10.2018 в 16:37
_Boroda_ Дата: Среда, 17.10.2018, 16:41 | Сообщение № 8
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15574
Репутация: 6075 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Правильно. Его же нет в списке столбца В. Сначала сортируем то, что есть в списке для сортировки (по этому списку), затем по алфавиту то, чего в списке сортировки нет.


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

Автор - _Boroda_
Дата добавления - 17.10.2018 в 16:41
AVI Дата: Среда, 17.10.2018, 17:15 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 503
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, Блин, я - дурак)) B3... а надо B2... Спасибо! Понял все!
 
Ответить
Сообщение_Boroda_, Блин, я - дурак)) B3... а надо B2... Спасибо! Понял все!

Автор - AVI
Дата добавления - 17.10.2018 в 17:15
AVI Дата: Понедельник, 26.11.2018, 05:17 | Сообщение № 10
Группа: Проверенные
Ранг: Ветеран
Сообщений: 503
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
Добрый день!
Помогите, пожалуйста, добавить в отчет на Листе3 "Операции со складом" из таблицы на Листе1 по каждой группе (серым выделено то, что нужно добавить для группы "Спирт"). Вообще, возможно ли так сделать?
К сообщению приложен файл: 2902586_2.xlsm(61.5 Kb)
 
Ответить
СообщениеДобрый день!
Помогите, пожалуйста, добавить в отчет на Листе3 "Операции со складом" из таблицы на Листе1 по каждой группе (серым выделено то, что нужно добавить для группы "Спирт"). Вообще, возможно ли так сделать?

Автор - AVI
Дата добавления - 26.11.2018 в 05:17
Pelena Дата: Понедельник, 26.11.2018, 09:48 | Сообщение № 11
Группа: Админы
Ранг: Местный житель
Сообщений: 14329
Репутация: 3132 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
AVI, один вопрос - одна тема. Читайте Правила форума


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеAVI, один вопрос - одна тема. Читайте Правила форума

Автор - Pelena
Дата добавления - 26.11.2018 в 09:48
AVI Дата: Понедельник, 26.11.2018, 09:53 | Сообщение № 12
Группа: Проверенные
Ранг: Ветеран
Сообщений: 503
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
Pelena, Так там тоже самое, по сути, просто дополнить результат отбора нужно
 
Ответить
СообщениеPelena, Так там тоже самое, по сути, просто дополнить результат отбора нужно

Автор - AVI
Дата добавления - 26.11.2018 в 09:53
Pelena Дата: Понедельник, 26.11.2018, 09:59 | Сообщение № 13
Группа: Админы
Ранг: Местный житель
Сообщений: 14329
Репутация: 3132 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Файлы разные, таблицы разные, да и задача другая. Нет?


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеФайлы разные, таблицы разные, да и задача другая. Нет?

Автор - Pelena
Дата добавления - 26.11.2018 в 09:59
AVI Дата: Понедельник, 26.11.2018, 18:11 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 503
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
Pelena, файл тот же, таблица чуть дополнена, задача такая же только дополненная. Но Вас не переспорить...
 
Ответить
СообщениеPelena, файл тот же, таблица чуть дополнена, задача такая же только дополненная. Но Вас не переспорить...

Автор - AVI
Дата добавления - 26.11.2018 в 18:11
Pelena Дата: Понедельник, 26.11.2018, 19:16 | Сообщение № 15
Группа: Админы
Ранг: Местный житель
Сообщений: 14329
Репутация: 3132 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Я допускаю, что не очень глубоко вникла в тему, и новый вопрос является уточняющим к предыдущему.
Тогда подождём Александра, он в теме и решит наш спор
[p.s.]На мой взгляд, давно бы создали новую тему и получили ответ[/p.s.]


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеЯ допускаю, что не очень глубоко вникла в тему, и новый вопрос является уточняющим к предыдущему.
Тогда подождём Александра, он в теме и решит наш спор
[p.s.]На мой взгляд, давно бы создали новую тему и получили ответ[/p.s.]

Автор - Pelena
Дата добавления - 26.11.2018 в 19:16
RAN Дата: Понедельник, 26.11.2018, 19:39 | Сообщение № 16
Группа: Друзья
Ранг: Участник клуба
Сообщений: 5109
Репутация: 1019 ±
Замечаний: 0% ±

2010
<<У бурмистра Власа бабушка Ненила
Починить избенку лесу попросила.
Отвечал: нет лесу, и не жди - не будет!"
"Вот приедет барин - барин нас рассудит,..>> (Н.Некрасов)
hands


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение<<У бурмистра Власа бабушка Ненила
Починить избенку лесу попросила.
Отвечал: нет лесу, и не жди - не будет!"
"Вот приедет барин - барин нас рассудит,..>> (Н.Некрасов)
hands

Автор - RAN
Дата добавления - 26.11.2018 в 19:39
_Boroda_ Дата: Четверг, 29.11.2018, 17:35 | Сообщение № 17
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15574
Репутация: 6075 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщениеhttp://www.excelworld.ru/forum/10-39973-264952-16-1543502055

Автор - _Boroda_
Дата добавления - 29.11.2018 в 17:35
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Отображение результат отбора с заданным порядком (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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