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

Вход

Регистрация

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

 

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

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
Мир MS Excel » Вопросы и решения » Готовые решения » Список всех дат из указанных диапазонов (Excel)
Список всех дат из указанных диапазонов
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 - по умолчанию добавляется текущий год,
[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 .
К сообщению приложен файл: 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
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 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
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2697
Репутация: 1123 ±
Замечаний: 0% ±

начинал с 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-го года.
на сколько я понял нужно немного поправить строку
[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 .


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеС прошедшим всех :) .
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
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2697
Репутация: 1123 ±
Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1
у Gustav, притормаживает из-за работы с диапазонами и функцией Large/Small

ТОЛЬКО из-за Large/Small. Закомментировал эту сортировку, придав окончанию своей функции следующий вид:
[vba]
Код
    'составляем список дат как целых чисел - номеров строк всех ячеек диапазона таблицы
    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
[/vba]
Получил такие результаты на своем компутере:
[vba]
Код
ДО комментирования сортировки:
Slavick: 1,0625
Gustav: 7,3359
krosav4ig: 3,6641

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


МОИ: Ник, Tip box: 41001663842605
 
Ответить
Сообщение
у Gustav, притормаживает из-за работы с диапазонами и функцией Large/Small

ТОЛЬКО из-за Large/Small. Закомментировал эту сортировку, придав окончанию своей функции следующий вид:
[vba]
Код
    'составляем список дат как целых чисел - номеров строк всех ячеек диапазона таблицы
    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
[/vba]
Получил такие результаты на своем компутере:
[vba]
Код
ДО комментирования сортировки:
Slavick: 1,0625
Gustav: 7,3359
krosav4ig: 3,6641

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

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

2019
ТОЛЬКО из-за Large/Small.

"сортировать/не сортировать" - я в своей версии убрал, так как не вижу практического смысла в неотсортированном списке дат

Теперь и весомый смысл добавился :) .
Закомментировал эту сортировку,

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


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
ТОЛЬКО из-за Large/Small.

"сортировать/не сортировать" - я в своей версии убрал, так как не вижу практического смысла в неотсортированном списке дат

Теперь и весомый смысл добавился :) .
Закомментировал эту сортировку,

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

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


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
тоже попробовать/попаразитировать?

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

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

Excel 2007,2010,2013
С прошедшим wine
у krosav4ig - думаю из-за регулярки немного тормозит

и я того же мнения
тестировал скорость словаря и коллекции

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

[vba]
Код
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
[/vba]

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


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

Сообщение отредактировал krosav4ig - Пятница, 05.01.2018, 22:23
 
Ответить
СообщениеС прошедшим wine
у krosav4ig - думаю из-за регулярки немного тормозит

и я того же мнения
тестировал скорость словаря и коллекции

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

[vba]
Код
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
[/vba]

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

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

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

я говорил про комплексную работу с колекцией.:
+ там есть выгрузка ключей сразу в массив

Вы не рассчитали этот ОЧЕНЬ важный показатель ;) .
а он у коллекции жутко тормозит - она не любит отдавать данные :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 .


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
то ли у мну моск еще не очухался то ли че-то тут не то...

я говорил про комплексную работу с колекцией.:
+ там есть выгрузка ключей сразу в массив

Вы не рассчитали этот ОЧЕНЬ важный показатель ;) .
а он у коллекции жутко тормозит - она не любит отдавать данные :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
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
ну я же говорил ...
моск еще не очухался

а еси так?


К сообщению приложен файл: 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
Дата добавления - 06.01.2018 в 16:32
SLAVICK Дата: Четверг, 11.01.2018, 11:44 | Сообщение № 13
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

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

[vba]
Код
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
[/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]
а еси так?

Без Класса - быстрее отрабатывает.
Интересно выходит:
[vba]
Код
'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
[/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 = True 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 = True
            Exit Function
        End If
    Next
End Function
[/vba]
Для arraylist похоже нужно сделать проверку элементов, как и для обычной коллекции?
Получились такие вот результаты:
К сообщению приложен файл: test_speed3.xlsm (25.5 Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщениеkrosav4ig,
моск еще не очухался то ли че-то тут не то...

[vba]
Код
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
[/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]
а еси так?

Без Класса - быстрее отрабатывает.
Интересно выходит:
[vba]
Код
'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
[/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 = True 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 = True
            Exit Function
        End If
    Next
End Function
[/vba]
Для arraylist похоже нужно сделать проверку элементов, как и для обычной коллекции?
Получились такие вот результаты:

Автор - SLAVICK
Дата добавления - 11.01.2018 в 11:44
Мир MS Excel » Вопросы и решения » Готовые решения » Список всех дат из указанных диапазонов (Excel)
  • Страница 1 из 1
  • 1
Поиск:

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