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

Вход

Регистрация

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

 

= Мир MS Excel/Сортировка Таблицы по ранее заданному списку - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сортировка Таблицы по ранее заданному списку (Макросы/Sub)
Сортировка Таблицы по ранее заданному списку
Elhust Дата: Вторник, 26.09.2017, 14:36 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 184
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
Доброго времени суток уважаемые специалисты и просто гуру Excel
Не понимаю как реализовать данные вопрос , прошу вашей помощи :'(
На листе 1 Таблица
На листе 2 список
нужно отсортировать по списку(
К сообщению приложен файл: _Microsoft_Exce.xls(31.0 Kb)


Каждый сам выбирает правила игры
 
Ответить
СообщениеДоброго времени суток уважаемые специалисты и просто гуру Excel
Не понимаю как реализовать данные вопрос , прошу вашей помощи :'(
На листе 1 Таблица
На листе 2 список
нужно отсортировать по списку(

Автор - Elhust
Дата добавления - 26.09.2017 в 14:36
and_evg Дата: Вторник, 26.09.2017, 14:57 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 353
Репутация: 60 ±
Замечаний: 0% ±

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

Автор - and_evg
Дата добавления - 26.09.2017 в 14:57
Elhust Дата: Вторник, 26.09.2017, 15:01 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 184
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
and_evg, а как это сделать с помощью vba ...?


Каждый сам выбирает правила игры
 
Ответить
Сообщениеand_evg, а как это сделать с помощью vba ...?

Автор - Elhust
Дата добавления - 26.09.2017 в 15:01
Elhust Дата: Среда, 27.09.2017, 08:56 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 184
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
and_evg, Вот работает как часы
[vba]
Код

Sub NewSortTest()
    Dim keyRange As Variant
    Dim sortNum As Long
    Dim d As Long
    Dim nomer As String
    

With ActiveWorkbook.Worksheets("Лист2")
lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
ReDim keyRange(lLastRow)
d = 0
For i = 1 To lLastRow
nomer = .Cells(i, 1)
keyRange(d) = nomer
d = d + 1
Next
End With

'keyRange = Array("110283", 110379, "110382", "110334", "110303", "110335")

    Application.AddCustomList ListArray:=keyRange
    sortNum = Application.CustomListCount
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range("A2:A46"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=sortNum, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").Sort
        .SetRange Range("A2:C46")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
[/vba]


Каждый сам выбирает правила игры

Сообщение отредактировал Elhust - Среда, 27.09.2017, 08:57
 
Ответить
Сообщениеand_evg, Вот работает как часы
[vba]
Код

Sub NewSortTest()
    Dim keyRange As Variant
    Dim sortNum As Long
    Dim d As Long
    Dim nomer As String
    

With ActiveWorkbook.Worksheets("Лист2")
lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
ReDim keyRange(lLastRow)
d = 0
For i = 1 To lLastRow
nomer = .Cells(i, 1)
keyRange(d) = nomer
d = d + 1
Next
End With

'keyRange = Array("110283", 110379, "110382", "110334", "110303", "110335")

    Application.AddCustomList ListArray:=keyRange
    sortNum = Application.CustomListCount
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range("A2:A46"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=sortNum, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").Sort
        .SetRange Range("A2:C46")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
[/vba]

Автор - Elhust
Дата добавления - 27.09.2017 в 08:56
Elhust Дата: Среда, 27.09.2017, 08:57 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 184
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
Вопрос Закрыт


Каждый сам выбирает правила игры
 
Ответить
СообщениеВопрос Закрыт

Автор - Elhust
Дата добавления - 27.09.2017 в 08:57
_Boroda_ Дата: Среда, 27.09.2017, 10:08 | Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15978
Репутация: 6209 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Elhust, не забудьте только потом убрать этот список, а то со временем у Вас их там накопится
Этот код убирает последний список
[vba]
Код
Application.DeleteCustomList ListNum:=Application.CustomListCount
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеElhust, не забудьте только потом убрать этот список, а то со временем у Вас их там накопится
Этот код убирает последний список
[vba]
Код
Application.DeleteCustomList ListNum:=Application.CustomListCount
[/vba]

Автор - _Boroda_
Дата добавления - 27.09.2017 в 10:08
Elhust Дата: Четверг, 28.09.2017, 09:39 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 184
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, Спасибо спасибо спасибо ))) я всё думал как это сделать ) а то он не бесконечный ) и это тупик был для меня до момента сейчас ) hands


Каждый сам выбирает правила игры
 
Ответить
Сообщение_Boroda_, Спасибо спасибо спасибо ))) я всё думал как это сделать ) а то он не бесконечный ) и это тупик был для меня до момента сейчас ) hands

Автор - Elhust
Дата добавления - 28.09.2017 в 09:39
Elhust Дата: Пятница, 17.11.2017, 14:16 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 184
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, Доброго времени суток , решил написать сюда же ..
Вопрос всё по теме Настраиваемого списка , он может содержать как я выяснил всего 291 значение ... подскажите что делать если надо отсортировать больше... Спасибо


Каждый сам выбирает правила игры
 
Ответить
Сообщение_Boroda_, Доброго времени суток , решил написать сюда же ..
Вопрос всё по теме Настраиваемого списка , он может содержать как я выяснил всего 291 значение ... подскажите что делать если надо отсортировать больше... Спасибо

Автор - Elhust
Дата добавления - 17.11.2017 в 14:16
RAN Дата: Пятница, 17.11.2017, 15:29 | Сообщение № 9
Группа: Друзья
Ранг: Участник клуба
Сообщений: 5327
Репутация: 1064 ±
Замечаний: 0% ±

2010
Примерно так
[vba]
Код
Sub NewSortTest()
    keyRange1 = Array("110071", "110034")
    Application.AddCustomList ListArray:=keyRange1
    sortNum = Application.CustomListCount
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=sortNum, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(1).Sort
        .SetRange Range("A1:C146")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.DeleteCustomList ListNum:=Application.CustomListCount
    keyRange2 = Array("29608", "18722")
    aa = Cells.Find("110034", , , , xlByRows, xlPrevious).Row + 1
    Application.AddCustomList ListArray:=keyRange2
    sortNum = Application.CustomListCount
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range("A" & aa), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=sortNum, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(1).Sort
        .SetRange Range("A" & aa & ":C146")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеПримерно так
[vba]
Код
Sub NewSortTest()
    keyRange1 = Array("110071", "110034")
    Application.AddCustomList ListArray:=keyRange1
    sortNum = Application.CustomListCount
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=sortNum, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(1).Sort
        .SetRange Range("A1:C146")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.DeleteCustomList ListNum:=Application.CustomListCount
    keyRange2 = Array("29608", "18722")
    aa = Cells.Find("110034", , , , xlByRows, xlPrevious).Row + 1
    Application.AddCustomList ListArray:=keyRange2
    sortNum = Application.CustomListCount
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range("A" & aa), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=sortNum, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(1).Sort
        .SetRange Range("A" & aa & ":C146")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
[/vba]

Автор - RAN
Дата добавления - 17.11.2017 в 15:29
_Boroda_ Дата: Пятница, 17.11.2017, 15:30 | Сообщение № 10
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15978
Репутация: 6209 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
У Вас же, судя по примеру, там одинаковое количество значений? Тогда просто подтяните на Лист2 ВПР-ом значения из Лист1


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеУ Вас же, судя по примеру, там одинаковое количество значений? Тогда просто подтяните на Лист2 ВПР-ом значения из Лист1

Автор - _Boroda_
Дата добавления - 17.11.2017 в 15:30
Elhust Дата: Пятница, 17.11.2017, 16:21 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 184
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
_Boroda_,
Тут получается так что задача немного изменилась и теперь выяснилось что значений разное количество , я пришел к выводу что проще разделить массив на подмассивы ну как описал RAN, я тоже думал так сделать только вот теперь встал вопрос как грамотно разделить одномерный массив на несколько массивов по 290 значений .. потом находить это значение и сортировать дальше не трогая то что уже отсортировалось
вот


Каждый сам выбирает правила игры
 
Ответить
Сообщение_Boroda_,
Тут получается так что задача немного изменилась и теперь выяснилось что значений разное количество , я пришел к выводу что проще разделить массив на подмассивы ну как описал RAN, я тоже думал так сделать только вот теперь встал вопрос как грамотно разделить одномерный массив на несколько массивов по 290 значений .. потом находить это значение и сортировать дальше не трогая то что уже отсортировалось
вот

Автор - Elhust
Дата добавления - 17.11.2017 в 16:21
Elhust Дата: Пятница, 17.11.2017, 16:22 | Сообщение № 12
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 184
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, не могу на форуме правда этой темы найти ( надо видимо создать ?


Каждый сам выбирает правила игры
 
Ответить
Сообщение_Boroda_, не могу на форуме правда этой темы найти ( надо видимо создать ?

Автор - Elhust
Дата добавления - 17.11.2017 в 16:22
RAN Дата: Пятница, 17.11.2017, 16:34 | Сообщение № 13
Группа: Друзья
Ранг: Участник клуба
Сообщений: 5327
Репутация: 1064 ±
Замечаний: 0% ±

2010
как грамотно разделить

Так же, как и не грамотно. Взять, и разделить.


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
как грамотно разделить

Так же, как и не грамотно. Взять, и разделить.

Автор - RAN
Дата добавления - 17.11.2017 в 16:34
_Boroda_ Дата: Пятница, 17.11.2017, 17:01 | Сообщение № 14
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15978
Репутация: 6209 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
А вот так если? Вообще без настраиваемых списков.
Пишем в столбец рядом порядковые номера в соответствии с расположением во втором массиве, сортируем по этому столбцу и потом удаляем его. Все это, конечно же, макросом
=======
Переделал немного (на 2 массива разбил). Код и файл перевложил
К сообщению приложен файл: 3470501_2.xls(51.0 Kb)


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

Автор - _Boroda_
Дата добавления - 17.11.2017 в 17:01
Elhust Дата: Суббота, 18.11.2017, 15:19 | Сообщение № 15
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 184
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, Афигеть !!! :) я поражен ! ) очень элегантно ) сейчас разберусь ) Спасибо


Каждый сам выбирает правила игры
 
Ответить
Сообщение_Boroda_, Афигеть !!! :) я поражен ! ) очень элегантно ) сейчас разберусь ) Спасибо

Автор - Elhust
Дата добавления - 18.11.2017 в 15:19
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сортировка Таблицы по ранее заданному списку (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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