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

Вход

Регистрация

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

 

= Мир MS Excel/Сортировка элементов Collection перед выгрузкой на лист - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сортировка элементов Collection перед выгрузкой на лист (Макросы/Sub)
Сортировка элементов Collection перед выгрузкой на лист
mss Дата: Вторник, 23.07.2019, 16:08 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 81
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Прошу помощи в дописания макроса по сортировке элементов Collection до выгрузки на лист от меньшего к большему в прилагаемом файле, спасибо
К сообщению приложен файл: 7443567.xlsm(17.7 Kb)
 
Ответить
СообщениеПрошу помощи в дописания макроса по сортировке элементов Collection до выгрузки на лист от меньшего к большему в прилагаемом файле, спасибо

Автор - mss
Дата добавления - 23.07.2019 в 16:08
_Boroda_ Дата: Вторник, 23.07.2019, 18:21 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15650
Репутация: 6115 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
А попробуйте без коллекции. И без массива. И без циклов. :)
[vba]
Код
Sub tt()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Cells(2, 1).Resize(Cells(Rows.Count, 1).End(3).Row).Clear
    With Sheets("Лист2")
        .Range("A2:A" & .Cells(.Rows.Count, 1).End(3).Row).Copy
    End With
    Cells(2, 1).PasteSpecial Paste:=xlPasteValues
    With Sheets("Лист3")
        .Range("A2:A" & .Cells(.Rows.Count, 1).End(3).Row).Copy
    End With
    Cells(Cells(Rows.Count, 1).End(3).Row + 1, 1).PasteSpecial Paste:=xlPasteValues
    r1_ = Cells(Rows.Count, 1).End(3).Row
    ActiveSheet.Range("A2:A" & r1_).RemoveDuplicates Columns:=1, Header:=xlNo
    Me.Sort.Apply
    Cells(1).Select
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
[/vba]
Есть предположение, что на больших массивах так может быть даже и побыстрее
К сообщению приложен файл: 7443567_2.xlsm(17.8 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеА попробуйте без коллекции. И без массива. И без циклов. :)
[vba]
Код
Sub tt()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Cells(2, 1).Resize(Cells(Rows.Count, 1).End(3).Row).Clear
    With Sheets("Лист2")
        .Range("A2:A" & .Cells(.Rows.Count, 1).End(3).Row).Copy
    End With
    Cells(2, 1).PasteSpecial Paste:=xlPasteValues
    With Sheets("Лист3")
        .Range("A2:A" & .Cells(.Rows.Count, 1).End(3).Row).Copy
    End With
    Cells(Cells(Rows.Count, 1).End(3).Row + 1, 1).PasteSpecial Paste:=xlPasteValues
    r1_ = Cells(Rows.Count, 1).End(3).Row
    ActiveSheet.Range("A2:A" & r1_).RemoveDuplicates Columns:=1, Header:=xlNo
    Me.Sort.Apply
    Cells(1).Select
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
[/vba]
Есть предположение, что на больших массивах так может быть даже и побыстрее

Автор - _Boroda_
Дата добавления - 23.07.2019 в 18:21
mss Дата: Вторник, 23.07.2019, 18:27 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 81
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Спасибо за ваш вариант, но проблема в том что мне именно надо выгружать в строку уже отсортированный диапазон, а у вас он в столбец выгружает, досадно:(
 
Ответить
СообщениеСпасибо за ваш вариант, но проблема в том что мне именно надо выгружать в строку уже отсортированный диапазон, а у вас он в столбец выгружает, досадно:(

Автор - mss
Дата добавления - 23.07.2019 в 18:27
krosav4ig Дата: Вторник, 23.07.2019, 18:34 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 2211
Репутация: 919 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Вариант с Arraylist

[vba]
Код
Sub элемент_таблицы()
    Dim myRange As Range, myCell As Range, AL As Object, v As Variant, r As Variant, _
    myElement As Variant, i As Long, smyRange As Range, ssmyRange As Range
    Dim LastRow
    Dim sLastRow
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    LastRow = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, 1).End(xlUp).Row
    sLastRow = Sheets("Лист3").Cells(Sheets("Лист3").Rows.Count, 1).End(xlUp).Row
    Set myRange = Sheets("Лист2").Range("A2:A" & LastRow)
    Set ssmyRange = Sheets("Лист3").Range("A2:A" & sLastRow)
    On Error Resume Next
    
    Set AL = CreateObject("system.Collections.Arraylist")

    For Each r In Array(myRange, ssmyRange)
        For Each v In r.Value
            If Not IsEmpty(v) And Not AL.contains(v) Then AL.Add v
    Next v, r
    AL.Sort

    On Error GoTo 0
    [проба!J2].Resize(, AL.Count) = AL.toarray
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеВариант с Arraylist

[vba]
Код
Sub элемент_таблицы()
    Dim myRange As Range, myCell As Range, AL As Object, v As Variant, r As Variant, _
    myElement As Variant, i As Long, smyRange As Range, ssmyRange As Range
    Dim LastRow
    Dim sLastRow
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    LastRow = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, 1).End(xlUp).Row
    sLastRow = Sheets("Лист3").Cells(Sheets("Лист3").Rows.Count, 1).End(xlUp).Row
    Set myRange = Sheets("Лист2").Range("A2:A" & LastRow)
    Set ssmyRange = Sheets("Лист3").Range("A2:A" & sLastRow)
    On Error Resume Next
    
    Set AL = CreateObject("system.Collections.Arraylist")

    For Each r In Array(myRange, ssmyRange)
        For Each v In r.Value
            If Not IsEmpty(v) And Not AL.contains(v) Then AL.Add v
    Next v, r
    AL.Sort

    On Error GoTo 0
    [проба!J2].Resize(, AL.Count) = AL.toarray
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 23.07.2019 в 18:34
mss Дата: Вторник, 23.07.2019, 18:42 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 81
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Спасибо большое то что надо hands , надеюсь 200 тыс. строк осилит :)
 
Ответить
СообщениеСпасибо большое то что надо hands , надеюсь 200 тыс. строк осилит :)

Автор - mss
Дата добавления - 23.07.2019 в 18:42
_Boroda_ Дата: Вторник, 23.07.2019, 19:55 | Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15650
Репутация: 6115 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
мне именно надо выгружать в строку уже отсортированный диапазон, а у вас он в столбец выгружает

Не заметил просто. Без проблем
К сообщению приложен файл: 7443567_54.xlsm(18.4 Kb)


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

Не заметил просто. Без проблем

Автор - _Boroda_
Дата добавления - 23.07.2019 в 19:55
krosav4ig Дата: Вторник, 23.07.2019, 20:10 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 2211
Репутация: 919 ±
Замечаний: 0% ±

Excel 2007,2010,2013
надо выгружать в строку

mss, а если, вдруг, количество уникальных значений будет >4^7 ?


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
надо выгружать в строку

mss, а если, вдруг, количество уникальных значений будет >4^7 ?

Автор - krosav4ig
Дата добавления - 23.07.2019 в 20:10
mss Дата: Среда, 24.07.2019, 02:05 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 81
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Boroda, спасибо, хороших идей ни когда не бывает много:), любые варианты в "копилочку". А по поводу максимального количеству уникальных, точно известно их будет <=120 просто перебираться массив может среди 200 тыс. строк., еще раз всем спасибо.
 
Ответить
СообщениеBoroda, спасибо, хороших идей ни когда не бывает много:), любые варианты в "копилочку". А по поводу максимального количеству уникальных, точно известно их будет <=120 просто перебираться массив может среди 200 тыс. строк., еще раз всем спасибо.

Автор - mss
Дата добавления - 24.07.2019 в 02:05
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сортировка элементов Collection перед выгрузкой на лист (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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