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

 

= Мир MS Excel/Список всех дат из указанных диапазонов - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин, DrMini  
Список всех дат из указанных диапазонов
SLAVICK Дата: Среда, 27.12.2017, 19:49 | Сообщение № 1
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Всем привет.
Прилетела мне задача помочь разобраться с отпусками.
Посмотрел тут и в готовых решениях есть красивые решения, но мне не подошло.
Основная особенность моей задачи была в том что нужно было разнести все даты указанные в двух ячейках:
Основная часть отпуска = минимум 14дней
Оставшаяся часть отпуска = остальные дни, как хочешь по одному, два ... подряд. Получается неограниченное количество диапазонов.

Поскольку я жутко ленивый, и боюсь ручных КопиПастов - эта задача подтолкнула меня сделать функцию, которая из строки с указанием диапазонов дат и дат создает полный перечень дат.
Получился такой вот монстр:


Например из строки:

"01.05.2019-05.05.2019;26.03-01.04;5.01;7.05-8.05;29.06;29.10-02.11;29.10.18-02.11.2018"
получаем список(массив) дат:
05.01.2018
26.03.2018
27.03.2018
.....
В функцию добавил сортировку, и возможность указать какой год добавить к краткому виду даты, например к 5.01 - по умолчанию добавляется текущий год,

ListDatesFromRanges_("01.05.2019-05.05.2019;26.03-01.04;5.01;7.05-8.05;29.06;29.10-02.11;29.10.18-02.11.2018")


но можно добавить например 2018.

ListDatesFromRanges_("01.05.2019-05.05.2019;26.03-01.04;5.01;7.05-8.05;29.06;29.10-02.11;29.10.18-02.11.2018";2018;1)


Также при помощи этой функции можно легко посчитать сколько же по факту уникальных дней находится в строке диапазонов.
при помощи простого Счёт

СЧЁТ(ListDatesFromRanges_("01.05.2019-05.05.2019;26.03-01.04;5.01;7.05-8.05;29.06;29.10-02.11;29.10.18-02.11.2018";2018))



Диапазоны дат с-по - через "-" или ":" .Например : "07.10-09.10" = 07.10, 08.10, 09.10
Несвязные даты - через "," или ";" .Например : "07.10;09.10" = 07.10, 09.10

В общем чтоб много не писать - остальное в файле наглядно видно.
Пожелания и замечания в мягкой форме приветствуются :D .
К сообщению приложен файл: ListAllDatesExa.xlsb (88.4 Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеВсем привет.
Прилетела мне задача помочь разобраться с отпусками.
Посмотрел тут и в готовых решениях есть красивые решения, но мне не подошло.
Основная особенность моей задачи была в том что нужно было разнести все даты указанные в двух ячейках:
Основная часть отпуска = минимум 14дней
Оставшаяся часть отпуска = остальные дни, как хочешь по одному, два ... подряд. Получается неограниченное количество диапазонов.

Поскольку я жутко ленивый, и боюсь ручных КопиПастов - эта задача подтолкнула меня сделать функцию, которая из строки с указанием диапазонов дат и дат создает полный перечень дат.
Получился такой вот монстр:


Например из строки:

"01.05.2019-05.05.2019;26.03-01.04;5.01;7.05-8.05;29.06;29.10-02.11;29.10.18-02.11.2018"
получаем список(массив) дат:
05.01.2018
26.03.2018
27.03.2018
.....
В функцию добавил сортировку, и возможность указать какой год добавить к краткому виду даты, например к 5.01 - по умолчанию добавляется текущий год,
[vba]
ListDatesFromRanges_("01.05.2019-05.05.2019;26.03-01.04;5.01;7.05-8.05;29.06;29.10-02.11;29.10.18-02.11.2018")
[/vba]
но можно добавить например 2018.
[vba]
ListDatesFromRanges_("01.05.2019-05.05.2019;26.03-01.04;5.01;7.05-8.05;29.06;29.10-02.11;29.10.18-02.11.2018";2018;1)
[/vba]
Также при помощи этой функции можно легко посчитать сколько же по факту уникальных дней находится в строке диапазонов.
при помощи простого Счёт
[vba]
СЧЁТ(ListDatesFromRanges_("01.05.2019-05.05.2019;26.03-01.04;5.01;7.05-8.05;29.06;29.10-02.11;29.10.18-02.11.2018";2018))
[/vba]

Диапазоны дат с-по - через "-" или ":" .Например : "07.10-09.10" = 07.10, 08.10, 09.10
Несвязные даты - через "," или ";" .Например : "07.10;09.10" = 07.10, 09.10

В общем чтоб много не писать - остальное в файле наглядно видно.
Пожелания и замечания в мягкой форме приветствуются :D .

Автор - SLAVICK
Дата добавления - 27.12.2017 в 19:49
krosav4ig Дата: Четверг, 28.12.2017, 18:21 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Привет.
Немного :) попаразитировал на коде


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 28.12.2017, 18:51
 
Ответить
СообщениеПривет.
Немного :) попаразитировал на коде

Автор - krosav4ig
Дата добавления - 28.12.2017 в 18:21
Gustav Дата: Воскресенье, 31.12.2017, 12:45 | Сообщение № 3
Группа: Админы
Ранг: Участник клуба
Сообщений: 2843
Репутация: 1194 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.1
Отлынивая от резки новогодних салатов, тоже повыпендриваюсь, не паразитируя, но творчески заимствуя некоторые операторы у предыдущих ораторов :) А также наследуя традиции темы Автоматическое заполнение элементов диапазона - с переходом от диапазонов внутри текстовой строки к диапазонам таблицы и обратно с преобразованием адресов диапазонов таблицы в числовые характеристики решаемой задачи, в данном конкретном случае - в даты.


Третий параметр исходной сигнатуры функции - "сортировать/не сортировать" - я в своей версии убрал, так как не вижу практического смысла в неотсортированном списке дат и выдаю из функции всегда отсортированную хронологическую последовательность. А вот за направление сортировки - по возрастанию или убыванию - как раз и отвечает мой третий параметр SortByDesc (= True для сортировки по убыванию, иначе - по возрастанию).

С Новым Годом!


МОИ: Ник, Tip box: 41001663842605
 
Ответить
СообщениеОтлынивая от резки новогодних салатов, тоже повыпендриваюсь, не паразитируя, но творчески заимствуя некоторые операторы у предыдущих ораторов :) А также наследуя традиции темы Автоматическое заполнение элементов диапазона - с переходом от диапазонов внутри текстовой строки к диапазонам таблицы и обратно с преобразованием адресов диапазонов таблицы в числовые характеристики решаемой задачи, в данном конкретном случае - в даты.


Третий параметр исходной сигнатуры функции - "сортировать/не сортировать" - я в своей версии убрал, так как не вижу практического смысла в неотсортированном списке дат и выдаю из функции всегда отсортированную хронологическую последовательность. А вот за направление сортировки - по возрастанию или убыванию - как раз и отвечает мой третий параметр SortByDesc (= True для сортировки по убыванию, иначе - по возрастанию).

С Новым Годом!

Автор - Gustav
Дата добавления - 31.12.2017 в 12:45
SLAVICK Дата: Среда, 03.01.2018, 17:11 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
С прошедшим всех :) .
krosav4ig, Gustav, смотрю Ваши варианты - мозг проснулся после выходных ... и чуть не закипел :D .

krosav4ig, интересно - с regexp думал, но мне кажется что с ним дольше будет на большИх объемах.
Есть баг: если поменять год с 2018 на 2019 - то даты 01.05.2019-05.05.2019 - 2018-го года.
на сколько я понял нужно немного поправить строку

D(i) = .subMatches(i * 2) & IIf(IsEmpty(.subMatches(i * 2 + 1)), "." & addYear, "")


на

D(i) = .subMatches(i * 2) & IIf(IsEmpty(.subMatches(i * 2 + 1)), "." & addYear, .subMatches(i * 2 + 1))


К моему величайшему стыду про "system.collections.arraylist" и не знал. Интересно как он справится с большим количеством данных, и есть ли везде эта библиотека? В общем озадачил меня - придется изучать :) .

Gustav, тоже очень интересно.
Использовать диапазоны, для получения списка - даже и не додумался бы. :( .
Смущает меня (пока) два момента, которые касаются быстродействия и универсальности (просто часто использую функции для работы данными из БД):

For Each cell In rng.Cells
...


по своему опыту "cell In rng.Cells" - работает достаточно долго - как в этом случае нужно посмотреть.
и

        With WorksheetFunction
            d(i) = CDate(IIf(SortByDesc, .Large(r, i), .Small(r, i)))
        End With


аналогично с предыдущим - мне кажется будет тормозить на большом количестве строк.
Я использую функцию не только для получения списка дат, но и для получения количества дней, поэтому сортировку делал опционной - чтобы было быстрее.
В Вашей функции количество определяется в первой части функции, поэтому думаю было бы хорошо добавить вариант "ответа" фунции(количество/список), и если нужно просто количество дней, то выходить из нее, не тратя время на просчет второй части.

В общем протестирую, немного позже - отпишусь тут specool .


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеС прошедшим всех :) .
krosav4ig, Gustav, смотрю Ваши варианты - мозг проснулся после выходных ... и чуть не закипел :D .

krosav4ig, интересно - с regexp думал, но мне кажется что с ним дольше будет на большИх объемах.
Есть баг: если поменять год с 2018 на 2019 - то даты 01.05.2019-05.05.2019 - 2018-го года.
на сколько я понял нужно немного поправить строку
[vba]
D(i) = .subMatches(i * 2) & IIf(IsEmpty(.subMatches(i * 2 + 1)), "." & addYear, "")
[/vba]
на
[vba]
D(i) = .subMatches(i * 2) & IIf(IsEmpty(.subMatches(i * 2 + 1)), "." & addYear, .subMatches(i * 2 + 1))
[/vba]
К моему величайшему стыду про "system.collections.arraylist" и не знал. Интересно как он справится с большим количеством данных, и есть ли везде эта библиотека? В общем озадачил меня - придется изучать :) .

Gustav, тоже очень интересно.
Использовать диапазоны, для получения списка - даже и не додумался бы. :( .
Смущает меня (пока) два момента, которые касаются быстродействия и универсальности (просто часто использую функции для работы данными из БД):
[vba]
For Each cell In rng.Cells...
[/vba]
по своему опыту "cell In rng.Cells" - работает достаточно долго - как в этом случае нужно посмотреть.
и
[vba]
        With WorksheetFunction            d(i) = CDate(IIf(SortByDesc, .Large(r, i), .Small(r, i)))        End With
[/vba]
аналогично с предыдущим - мне кажется будет тормозить на большом количестве строк.
Я использую функцию не только для получения списка дат, но и для получения количества дней, поэтому сортировку делал опционной - чтобы было быстрее.
В Вашей функции количество определяется в первой части функции, поэтому думаю было бы хорошо добавить вариант "ответа" фунции(количество/список), и если нужно просто количество дней, то выходить из нее, не тратя время на просчет второй части.

В общем протестирую, немного позже - отпишусь тут specool .

Автор - SLAVICK
Дата добавления - 03.01.2018 в 17:11
SLAVICK Дата: Четверг, 04.01.2018, 18:13 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Как и обещал - сделал сравнение.
пока у мну быстрее всех работает на вывод всех дат :) :
На 1000 строках:
Slavick: 2,2188
Gustav: 10,6016
krosav4ig: 5,3438

Как и предполагал - у Gustav, притормаживает из-за работы с диапазонами и функцией Large/Small
у krosav4ig - думаю из-за регулярки немного тормозит- они такие противные на длинных текстах :( .
Могу ошибаться - по причинам детально в этапы не влазил - просто предположение..
К сообщению приложен файл: 1019199.xlsb (35.7 Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеКак и обещал - сделал сравнение.
пока у мну быстрее всех работает на вывод всех дат :) :
На 1000 строках:
Slavick: 2,2188
Gustav: 10,6016
krosav4ig: 5,3438

Как и предполагал - у Gustav, притормаживает из-за работы с диапазонами и функцией Large/Small
у krosav4ig - думаю из-за регулярки немного тормозит- они такие противные на длинных текстах :( .
Могу ошибаться - по причинам детально в этапы не влазил - просто предположение..

Автор - SLAVICK
Дата добавления - 04.01.2018 в 18:13
Gustav Дата: Четверг, 04.01.2018, 20:04 | Сообщение № 6
Группа: Админы
Ранг: Участник клуба
Сообщений: 2843
Репутация: 1194 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.1
Цитата SLAVICK, 04.01.2018 в 18:13, в сообщении № 5 ( писал(а)):
у Gustav, притормаживает из-за работы с диапазонами и функцией Large/Small

ТОЛЬКО из-за Large/Small. Закомментировал эту сортировку, придав окончанию своей функции следующий вид:

    'составляем список дат как целых чисел - номеров строк всех ячеек диапазона таблицы
    For Each cell In rng.Cells
        i = i + 1
        d(i) = CDate(cell.Row)
    Next
    'получаем окончательный список уникальных дат в хронологическом порядке
    '- возрастающем (если SortByDesc = False) или убывающем (если SortByDesc = True)
    'For i = 1 To rng.Cells.Count
    '    With WorksheetFunction
    '        d(i) = CDate(IIf(SortByDesc, .Large(r, i), .Small(r, i)))
    '    End With
    'Next
    
    ListDatesFromRanges_Gustav = d
End Function


Получил такие результаты на своем компутере:

ДО комментирования сортировки:
Slavick: 1,0625
Gustav: 7,3359
krosav4ig: 3,6641

ПОСЛЕ комментирования сортировки:
Slavick: 1,0781
Gustav: 0,4063
krosav4ig: 3,5391



МОИ: Ник, Tip box: 41001663842605
 
Ответить
Сообщение
Цитата SLAVICK, 04.01.2018 в 18:13, в сообщении № 5 ( писал(а)):
у Gustav, притормаживает из-за работы с диапазонами и функцией Large/Small

ТОЛЬКО из-за Large/Small. Закомментировал эту сортировку, придав окончанию своей функции следующий вид:
[vba]
    'составляем список дат как целых чисел - номеров строк всех ячеек диапазона таблицы    For Each cell In rng.Cells        i = i + 1        d(i) = CDate(cell.Row)    Next    'получаем окончательный список уникальных дат в хронологическом порядке    '- возрастающем (если SortByDesc = False) или убывающем (если SortByDesc = Тrue)    'For i = 1 To rng.Cells.Count    '    With WorksheetFunction    '        d(i) = CDate(IIf(SortByDesc; .Large(r; i); .Small(r; i)))    '    End With    'Next        ListDatesFromRanges_Gustav = dEnd Function
[/vba]
Получил такие результаты на своем компутере:
[vba]
ДО комментирования сортировки:Slavick: 1,0625Gustav: 7,3359krosav4ig: 3,6641ПОСЛЕ комментирования сортировки:Slavick: 1,0781Gustav: 0,4063krosav4ig: 3,5391
[/vba]

Автор - Gustav
Дата добавления - 04.01.2018 в 20:04
SLAVICK Дата: Пятница, 05.01.2018, 01:00 | Сообщение № 7
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Цитата Gustav, 04.01.2018 в 20:04, в сообщении № 6 ( писал(а)):
ТОЛЬКО из-за Large/Small.

Цитата Gustav, 31.12.2017 в 12:45, в сообщении № 3 ( писал(а)):
"сортировать/не сортировать" - я в своей версии убрал, так как не вижу практического смысла в неотсортированном списке дат

Теперь и весомый смысл добавился :) .
Цитата Gustav, 04.01.2018 в 20:04, в сообщении № 6 ( писал(а)):
Закомментировал эту сортировку,

А у меня Вы сортировку не отключали?
Дома решил посмотреть на ноутбуке(win10 office 2016*64) - код krosav4ig не запустился- выдало "Automation Error" - причины расследую... поэтому сравнивал только две процедуры:

'Без сортировки
Slavick: 2,0156
Gustav: 1,0313
'С сортировкой
Slavick: 2,4688
Gustav: 18,8281


Выходит у Вас первая часть быстрее моей в два раза, а у меня сортировка шустрее.
Думаю их стоит соединить.
Будет время - займусь.


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
Цитата Gustav, 04.01.2018 в 20:04, в сообщении № 6 ( писал(а)):
ТОЛЬКО из-за Large/Small.

Цитата Gustav, 31.12.2017 в 12:45, в сообщении № 3 ( писал(а)):
"сортировать/не сортировать" - я в своей версии убрал, так как не вижу практического смысла в неотсортированном списке дат

Теперь и весомый смысл добавился :) .
Цитата Gustav, 04.01.2018 в 20:04, в сообщении № 6 ( писал(а)):
Закомментировал эту сортировку,

А у меня Вы сортировку не отключали?
Дома решил посмотреть на ноутбуке(win10 office 2016*64) - код krosav4ig не запустился- выдало "Automation Error" - причины расследую... поэтому сравнивал только две процедуры:
[vba]
'Без сортировкиSlavick: 2,0156Gustav: 1,0313'С сортировкойSlavick: 2,4688Gustav: 18,8281
[/vba]
Выходит у Вас первая часть быстрее моей в два раза, а у меня сортировка шустрее.
Думаю их стоит соединить.
Будет время - займусь.

Автор - SLAVICK
Дата добавления - 05.01.2018 в 01:00
nilem Дата: Пятница, 05.01.2018, 10:54 | Сообщение № 8
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
Здравствуйте! Можно тоже попробовать/попаразитировать? :)

upd
или так:


Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Пятница, 05.01.2018, 12:11
 
Ответить
СообщениеЗдравствуйте! Можно тоже попробовать/попаразитировать? :)

upd
или так:

Автор - nilem
Дата добавления - 05.01.2018 в 10:54
SLAVICK Дата: Пятница, 05.01.2018, 14:28 | Сообщение № 9
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Цитата nilem, 05.01.2018 в 10:54, в сообщении № 8 ( писал(а)):
тоже попробовать/попаразитировать?

отчего же нельзя? :D .
будет время - докину в сравнение. Но сразу скажу что когда-то тестировал скорость словаря и коллекции - словарь победил + там есть выгрузка ключей сразу в массив.(это я про второй вариант)
И сортировку, как придумал Gustav, - наверное нужно переделать(и мне) опционно по убыванию или возрастанию - для универсальности.


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
Цитата nilem, 05.01.2018 в 10:54, в сообщении № 8 ( писал(а)):
тоже попробовать/попаразитировать?

отчего же нельзя? :D .
будет время - докину в сравнение. Но сразу скажу что когда-то тестировал скорость словаря и коллекции - словарь победил + там есть выгрузка ключей сразу в массив.(это я про второй вариант)
И сортировку, как придумал Gustav, - наверное нужно переделать(и мне) опционно по убыванию или возрастанию - для универсальности.

Автор - SLAVICK
Дата добавления - 05.01.2018 в 14:28
krosav4ig Дата: Пятница, 05.01.2018, 22:07 | Сообщение № 10
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
С прошедшим wine
Цитата SLAVICK, 03.01.2018 в 17:11, в сообщении № 4 ( писал(а)):
у krosav4ig - думаю из-за регулярки немного тормозит

и я того же мнения
Цитата SLAVICK, 05.01.2018 в 01:00, в сообщении № 7 ( писал(а)):
тестировал скорость словаря и коллекции

то ли у мну моск еще не очухался то ли че-то тут не то...

filling arraylist with 10^6 random numbers took 10,6250 seconds
sorting 10^6 random numbers in ascending order with Arraylist took 1,3906 seconds
sorting 10^6 random numbers in descending order with Arraylist took 1,4375 seconds
filling dictionary with 10^6 random numbers took 72,2813 seconds
sorting 10^6 random numbers in descending order with quicksort took 7,3203 seconds
filling collection with 10^6 random numbers took 0,2188 seconds



Добавил сортировку по убыванию


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Пятница, 05.01.2018, 22:23
 
Ответить
СообщениеС прошедшим wine
Цитата SLAVICK, 03.01.2018 в 17:11, в сообщении № 4 ( писал(а)):
у krosav4ig - думаю из-за регулярки немного тормозит

и я того же мнения
Цитата SLAVICK, 05.01.2018 в 01:00, в сообщении № 7 ( писал(а)):
тестировал скорость словаря и коллекции

то ли у мну моск еще не очухался то ли че-то тут не то...

[vba]
filling arraylist with 10^6 random numbers took 10,6250 secondssorting 10^6 random numbers in ascending order with Arraylist took 1,3906 secondssorting 10^6 random numbers in descending order with Arraylist took 1,4375 secondsfilling dictionary with 10^6 random numbers took 72,2813 secondssorting 10^6 random numbers in descending order with quicksort took 7,3203 secondsfilling collection with 10^6 random numbers took 0,2188 seconds
[/vba]

Добавил сортировку по убыванию

Автор - krosav4ig
Дата добавления - 05.01.2018 в 22:07
SLAVICK Дата: Суббота, 06.01.2018, 00:29 | Сообщение № 11
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Цитата krosav4ig, 05.01.2018 в 22:07, в сообщении № 10 ( писал(а)):
то ли у мну моск еще не очухался то ли че-то тут не то...

я говорил про комплексную работу с колекцией.:
Цитата SLAVICK, 05.01.2018 в 14:28, в сообщении № 9 ( писал(а)):
+ там есть выгрузка ключей сразу в массив

Вы не рассчитали этот ОЧЕНЬ важный показатель ;) .
а он у коллекции жутко тормозит - она не любит отдавать данные :o :) .
Я попаразитировал на Вашем коде ;) и добавил пару показателей..
Весь код не влазит в сообщение - поэтому только то что добавил.
Потом протестировал на 10^5 и 10^6 - получились такие результаты:


Дождатся завершения items to array NEW collection - не смог, поэтому остановил код на 235734, и это заняло у моего ноута 1026с
Странно, что на 10^5 - показатели словаря лучше чем у arraylist, а при 10^6 - значительно хуже
По поводу работы со словарем: есть несколько тонкостей, которые улучшают работу с ним:
можно писать не

DIC.Add r, r


а

DIC(r) = 1

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

вместо

Set Dic = CreateObject("scripting.dictionary")

лучше подключить библиотеку и использовать :

Dim DIC_NEW As New Scripting.Dictionary


Тогда будет быстрее работать + сразу подсказки вылазят - удобно yes .


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
Цитата krosav4ig, 05.01.2018 в 22:07, в сообщении № 10 ( писал(а)):
то ли у мну моск еще не очухался то ли че-то тут не то...

я говорил про комплексную работу с колекцией.:
Цитата SLAVICK, 05.01.2018 в 14:28, в сообщении № 9 ( писал(а)):
+ там есть выгрузка ключей сразу в массив

Вы не рассчитали этот ОЧЕНЬ важный показатель ;) .
а он у коллекции жутко тормозит - она не любит отдавать данные :o :) .
Я попаразитировал на Вашем коде ;) и добавил пару показателей..
Весь код не влазит в сообщение - поэтому только то что добавил.
Потом протестировал на 10^5 и 10^6 - получились такие результаты:


Дождатся завершения items to array NEW collection - не смог, поэтому остановил код на 235734, и это заняло у моего ноута 1026с
Странно, что на 10^5 - показатели словаря лучше чем у arraylist, а при 10^6 - значительно хуже
По поводу работы со словарем: есть несколько тонкостей, которые улучшают работу с ним:
можно писать не
[vba]
DIC.Add r, r
[/vba]
а
[vba]
DIC(r) = 1
[/vba]этого достаточно для создания словаря без ошибок, если нам нужны просто уникальные значения, без айтемов.

вместо
[vba]
Set Dic = CreateObject("scripting.dictionary")
[/vba]лучше подключить библиотеку и использовать :
[vba]
Dim DIC_NEW As New Scripting.Dictionary
[/vba]
Тогда будет быстрее работать + сразу подсказки вылазят - удобно yes .

Автор - SLAVICK
Дата добавления - 06.01.2018 в 00:29
krosav4ig Дата: Суббота, 06.01.2018, 16:32 | Сообщение № 12
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
ну я же говорил ...
Цитата krosav4ig, 05.01.2018 в 22:07, в сообщении № 10 ( писал(а)):
моск еще не очухался

а еси так?


К сообщению приложен файл: Module1.bas (0.7 Kb) · kludge.cls (0.4 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Суббота, 06.01.2018, 16:36
 
Ответить
Сообщениену я же говорил ...
Цитата krosav4ig, 05.01.2018 в 22:07, в сообщении № 10 ( писал(а)):
моск еще не очухался

а еси так?



Автор - krosav4ig
Дата добавления - 06.01.2018 в 16:32
SLAVICK Дата: Четверг, 11.01.2018, 11:44 | Сообщение № 13
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
krosav4ig,
Цитата krosav4ig, 05.01.2018 в 22:07, в сообщении № 10 ( писал(а)):
моск еще не очухался то ли че-то тут не то...

Sub testALLWithoutKluge()
    Dim coll As Collection, n&
    Dim AL As Object, Dic As Object, t#, r#
    Dim Al1 As Object
    Dim arr()
    n = 10 ^ 6
    Randomize
'    ======Collections==================================
    Set coll = New Collection
    On Error Resume Next
    t = Timer
    For i = 1 To n
        coll.Add 1
    Next
    t = Timer - t
    Debug.Print "collection.count = " & coll.Count
    Debug.Print "filling collection with "; n; " random numbers took "; Format(t, "0.0000"); " seconds"
    
    
'    ======Collections with KEY==================================
    Set coll = New Collection
    On Error Resume Next
    t = Timer
    For i = 1 To n
        coll.Add 1, CStr(Rnd)
    Next
    t = Timer - t
    Debug.Print "collection.count = " & coll.Count
    Debug.Print "filling collection with "; n; " random numbers took "; Format(t, "0.0000"); " seconds"
End Sub


это по поводу добавления в коллекцию - Вы предложили - а я упустил...

For i = 1 To n
        coll.Add 1
    Next


создает n элементов = 1, хотя нам же нужно было получить уникальные...
для arraylist похоже та же беда:

    Set AL = CreateObject("system.collections.arraylist")
    t = Timer
    For i = 1 To n
        r = Rnd
        AL.Add 1
    Next
    Debug.Print AL.Count


Цитата krosav4ig, 06.01.2018 в 16:32, в сообщении № 12 ( писал(а)):
а еси так?

Без Класса - быстрее отрабатывает.
Интересно выходит:

'With Class Module kluge
filling collection with  100000  random numbers took 0,2793 seconds
copying  100000  values from objects in collection  Use For Each...Next to an array took 0,0371 seconds
copying  100000  values from objects in collection Use For ...Next to an array took 30,2617 seconds
'Without Class Module kluge
filling collection with  100000  random numbers took 0,0391 seconds
copying  100000  values from objects in collection  Use For Each...Next to an array took 0,0156 seconds
copying  100000  values from objects in collection Use For...Next to an array took 29,4785 seconds



Получается, что Coll(i) - желательно вообще не использовать при передаче элементов коллекции в массив...

Решил добавить еще один показатель: Время проверки наличия элемента в коллекции(словаре).
для коллекции придумался такой код:

Function CollectionContains1(myCol As Collection, checkVal As Variant) As Boolean
    On Error Resume Next
    myCol.Add checkVal, CStr(checkVal)
    If Err Then CollectionContains1 = True Else myCol.Remove (CStr(checkVal))
End Function


Так на порядок быстрее чем:

Function CollectionContains(myCol As Collection, checkVal As Variant) As Boolean
    On Error Resume Next
    CollectionContains = False
    Dim it As Variant
    For Each it In myCol
        If it = checkVal Then
            CollectionContains = True
            Exit Function
        End If
    Next
End Function


Для arraylist похоже нужно сделать проверку элементов, как и для обычной коллекции?
Получились такие вот результаты:
К сообщению приложен файл: test_speed3.xlsm (25.5 Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщениеkrosav4ig,
Цитата krosav4ig, 05.01.2018 в 22:07, в сообщении № 10 ( писал(а)):
моск еще не очухался то ли че-то тут не то...

[vba]
Sub testALLWithoutKluge()    Dim coll As Collection, n&    Dim AL As Object, Dic As Object, tr, DimAl1    As Object Dim n    Randomize arr()    Collections = 10 ^ 6    Set'    ======coll==================================    New Collection = On Error    Resume Next t Timer    For = i    To n = 1 coll.Add Next        t 1    Timer    t = Debug.Print - coll.Count    Debug.Print "collection.count = " & n    t "filling collection with "; Collections; " random numbers took "; Format(with, "0.0000"); " seconds"        '    ======KEY Set coll==================================    New Collection = On Error    Resume Next t Timer    For = i    To n = 1 coll.Add Rnd        Next 1, CStr(t)    Timer    t = Debug.Print - coll.Count    Debug.Print "collection.count = " & n    t "filling collection with "; End; " random numbers took "; Format(Sub, "0.0000"); " seconds"undefined undefined
[/vba]
это по поводу добавления в коллекцию - Вы предложили - а я упустил...
[vba]
For i = 1 To n        coll.Add 1    Next
[/vba]
создает n элементов = 1, хотя нам же нужно было получить уникальные...
для arraylist похоже та же беда:
[vba]
    Set AL = CreateObject("system.collections.arraylist")    t = Timer    For i = 1 To n        r = Rnd        AL.Add 1    Next    Debug.Print AL.Count
[/vba]
Цитата krosav4ig, 06.01.2018 в 16:32, в сообщении № 12 ( писал(а)):
а еси так?

Без Класса - быстрее отрабатывает.
Интересно выходит:
[vba]
'With Class Module klugefilling collection with  100000  random numbers took 0,2793 secondscopying  100000  values from objects in collection  Use For Each...Next to an array took 0,0371 secondscopying  100000  values from objects in collection Use For ...Next to an array took 30,2617 seconds'Without Class Module klugefilling collection with  100000  random numbers took 0,0391 secondscopying  100000  values from objects in collection  Use For Each...Next to an array took 0,0156 secondscopying  100000  values from objects in collection Use For...Next to an array took 29,4785 seconds
[/vba]

Получается, что Coll(i) - желательно вообще не использовать при передаче элементов коллекции в массив...

Решил добавить еще один показатель: Время проверки наличия элемента в коллекции(словаре).
для коллекции придумался такой код:
[vba]
Function CollectionContains1(myCol As Collection; checkVal As Variant) As Boolean    On Error Resume Next    myCol.Add checkVal; CStr(checkVal)    If Err Then CollectionContains1 = Тrue Else myCol.Remove (CStr(checkVal))End Function
[/vba]
Так на порядок быстрее чем:
[vba]
Function CollectionContains(myCol As Collection; checkVal As Variant) As Boolean    On Error Resume Next    CollectionContains = False    Dim it As Variant    For Each it In myCol        If it = checkVal Then            CollectionContains = Тrue            Exit Function        End If    NextEnd Function
[/vba]
Для arraylist похоже нужно сделать проверку элементов, как и для обычной коллекции?
Получились такие вот результаты:

Автор - SLAVICK
Дата добавления - 11.01.2018 в 11:44
  • Страница 1 из 1
  • 1
Поиск:

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