ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Узнать все доступные значения при установке автофильтра
25 сообщений из 78, страница 3 из 4
  3  все
Узнать все доступные значения при установке автофильтра
    #35724448
_slan_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_slan_
Участник
A-Nik,

1 не понял смысла применения with

2 отказ от transpose проверял - немного давало..

3 вот использование константы.. это мысль

4 чем не нравится on error goto erm ? :)

5 еще думал над получением текстового массива, чтобы избежать конвертации в ключ
...
Рейтинг: 0 / 0
19.12.2008, 12:47
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35724460
_slan_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_slan_
Участник
ps
for each тоже хотел.. но .. что-то не срослось :)
...
Рейтинг: 0 / 0
19.12.2008, 12:49
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35725723
x
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
x
Гость
Добрый вечер, Слэн и всем!
Вчера решил погуглить, где кто. Набрал Slan – попал сюда.
Набрал свои три буквы - тоже тут оказался :-)
Судьба, значит. Почитал, и вот за коллекции немного заступился.
По вопросам:
- прирост скорости дает? –> все относительно, но вроде дает
- экономия памяти не актуальна –> это для небольшой экономии времени
- смысл применения with –> теоретически должно быть чуть экономнее 2-х ссылок на Rng
- если будет не массив –> справедливо, но не только для этого варианта ;)
- избежать конвертации в текстовый ключ –> наверное, но это нужно пробовать

Еще Range("CalcTime") быстрее, чем [CalcTime]

А Scripting.Dictionary вообще пошустрее коллекций на больших массивах.
А если с ранним связыванием, то и на малых.

Компания здесь интересная, но с временем напряг, а там еще и планета Павлова открылась ;-)
Всех - с наступающим Новым годом!
ZVI
...
Рейтинг: 0 / 0
20.12.2008, 01:00
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35725837
_slan_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_slan_
Участник
приветZVI!
а мы тут Вашу идею дорабатываем. :)

я понимаю, что for each быстрее , чем со счетчиком - проверял. :)
но в чем выигрыш от использования одного массива?

да, второе обращение к диапазону я пропустил :)
...
Рейтинг: 0 / 0
20.12.2008, 11:05
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35725936
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
A-Nik
Гость
xА Scripting.Dictionary вообще пошустрее коллекций на больших массивах.
А если с ранним связыванием, то и на малых.
А примерчик можно в разрезе данной задачи ? ;-) Даже два - для раннего и позднего связывания :-)
xКомпания здесь интересная, но с временем напряг, а там еще и планета Павлова открылась ;-)
Всех - с наступающим Новым годом!
ZVI
Вот и подключайся :-)
За поздравление - спасибо! ;-)
...
Рейтинг: 0 / 0
20.12.2008, 15:15
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35726069
_slan_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_slan_
Участник
а мне еще чуть-чуть убыстрить удалось! :)

Private Sub CommandButton3_Click()
Dim l&, lm&
lm = [steps]
Columns(2).ClearContents
Dim arr, x, c As New Collection, t As Single
t = Timer
On Error GoTo erm
Application.ScreenUpdating = False
For l = 0 To lm
With Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
arr = Application.Transpose(.Value)
For Each x In arr
c.Add 0, CStr(x)
arr(c.Count) = x
erm: Resume nxt
nxt: Next
ReDim Preserve arr(c.Count)
.Offset(, 1).Value = Application.Transpose(arr)
End With
Next
Range("CalcTime") = Timer - t
End Sub


и в определенных условиях вдвое..

внешний цикл нужен для определения разницы методов с if err и goto erm

goto erm выигрывает 1,5% :)
...
Рейтинг: 0 / 0
20.12.2008, 19:35
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35726075
_slan_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_slan_
Участник
вот файл
...
Рейтинг: 0 / 0
20.12.2008, 19:40
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35726105
_slan_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_slan_
Участник
исправление: ReDim Preserve arr(1 To c.Count)

и выигрывает при большом количестве повторов, а при отсутствии - проигрывает
...
Рейтинг: 0 / 0
20.12.2008, 20:38
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35726148
ZVI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ZVI
Участник
Обещанное сравнение Dictionary и Collection.

Для чистоты эксперимента общее время взаимодействия VBA на загрузку/выгрузку данных из/в таблицу Excel не учитывается. Основная часть кода также практически одинакова для этой же цели.

Тестовые данные (почти случайные числа и строки) для уменьшения размера файла удалил.
Жмите "Очистить" чтобы очистить старые и создать новые тестовые данные.
Назначение остальных кнопок очевидно.

---
ZVI
...
Рейтинг: 0 / 0
20.12.2008, 21:40
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35726157
ZVI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ZVI
Участник
Забыл уточнить про связывание.

В примере закомментируйте эту строку:
With CreateObject("Scripting.Dictionary") ' Позднее связывание

И раскомментируйте эту (Reference уже установлен):
'With New Dictionary ' Раннее связывание, нужен Reference на MS Scripting Runtime

и почувствуйте разницу :-)
...
Рейтинг: 0 / 0
20.12.2008, 21:52
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35726248
KL (XL)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
KL (XL)
Участник
Вот это было написано Джоном Уокенбахом довольно давно. В моем Excel 2007 (под Vista) и с данными последнего примера, этот код быстрее самого быстрого из последних вариантов _slan_ в 3 раза (мне вообще не очень понятно почему все решения используют транспонирование дважды):

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant
    Dim Unique() As Variant
    Dim Element As Variant
    Dim i As Integer
    Dim FoundMatch As Boolean
    Dim NumUnique
        
    If IsMissing(Count) Then Count = True
        
    NumUnique =  0 
        
    For Each Element In ArrayIn
        FoundMatch = False

        For i =  1  To NumUnique
            If Element = Unique(i) Then
                FoundMatch = True
                GoTo AddItem
            End If
        Next i
AddItem:
        If Not FoundMatch Then
            NumUnique = NumUnique +  1 
            ReDim Preserve Unique(NumUnique)
            Unique(NumUnique) = Element
        End If
    
    Next Element
    If Count Then UniqueItems = NumUnique Else UniqueItems = Unique
End Function

Private Sub CommandButton4_Click()
    Dim t As Single
    t = Timer
    Application.ScreenUpdating = False
    With Range(Cells( 2 ,  1 ), Cells(Rows.Count,  1 ).End(xlUp))
        .Offset(,  1 ) = UniqueItems(.Value, False)
    End With
    Range("CalcTime") = Timer - t
End Sub
...
Рейтинг: 0 / 0
20.12.2008, 23:40
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35726264
KL (XL)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
KL (XL)
Участник
Пардон, адаптация кода была с дефектом. Исправленный код дает меньший выигрыш (13%), но все же:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
Private Sub CommandButton4_Click()
    Dim Unique() As Variant
    Dim rng As Range
    Dim Element As Variant
    Dim i As Integer
    Dim FoundMatch As Boolean
    Dim NumUnique
    Dim t As Single
    
    Columns( 2 ).ClearContents
    
    t = Timer
    Application.ScreenUpdating = False
        
    Set rng = Range(Cells( 2 ,  1 ), Cells(Rows.Count,  1 ).End(xlUp))
        
    NumUnique =  0 
        
    For Each Element In rng
        FoundMatch = False

        For i =  1  To NumUnique
            If Element = Unique(i) Then
                FoundMatch = True
                GoTo AddItem
            End If
        Next i
AddItem:
        If Not FoundMatch Then
            NumUnique = NumUnique +  1 
            ReDim Preserve Unique(NumUnique)
            Unique(NumUnique) = Element
        End If
    
    Next Element
    rng.Offset(,  1 ).Resize(NumUnique).Value = Application.Transpose(Unique())
    Range("CalcTime") = Timer - t
End Sub
...
Рейтинг: 0 / 0
21.12.2008, 00:00
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35726268
ZVI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ZVI
Участник
KL (XL)Вот это было написано Джоном Уокенбахом довольно давно. В моем Excel 2007 (под Vista) и с данными последнего примера, этот код быстрее самого быстрого из последних вариантов _slan_ в 3 раза (мне вообще не очень понятно почему все решения используют транспонирование дважды):
...

Попробуйте использовать этот вариант на 60000 ячейках из моего примера.
Получите примерно в 290 раз медленнее. чем с Dictionary с ранним связыванием.
Переопределение размера массива Redim() означает reallocation memory, что при большом массиве сильно тормозит.
...
Рейтинг: 0 / 0
21.12.2008, 00:01
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35727793
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
A-Nik
Гость
Да, KL, метод Уокенбаха, честно сказать, меня только рассмешил Кстати, метод с ранним связыванием - тоже :-) Не ожидал такой скорости работы :-)
Единственное, что могу предложить, так это ещё немного оптимизировать цикл для варианта с коллекцией:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Private Sub CommandButton4_Click()
Dim arr, arr1, x, c As New Collection, t As Single
  Columns( 2 ).ClearContents
  t = Timer
  On Error GoTo erm
  Application.ScreenUpdating = False
  arr = Range(Cells( 2 ,  1 ), Cells(Rows.Count,  1 ).End(xlUp))
  ReDim arr1( 1  To UBound(arr),  1  To  1 )
  For Each x In arr
    c.Add  0 , CStr(x)
    arr1(c.Count,  1 ) = x
nxt: Next
  Cells( 2 ,  2 ).Resize(c.Count) = arr1
  [CalcTime] = Timer - t
  Exit Sub
erm: Resume nxt
End Sub
Здесь можно было бы просто сделать On Error Resume Next , но так оказывается чуть дольше :-) (заменто на 65000 строках)
...
Рейтинг: 0 / 0
22.12.2008, 13:57
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35727889
ZVI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ZVI
Участник
A-NikДа, KL, метод Уокенбаха, честно сказать, меня только рассмешил Кстати, метод с ранним связыванием - тоже :-) Не ожидал такой скорости работы :-)
...

Так метод с ранним связыванием тоже рассмешил или порадовал?
:-)
...
Рейтинг: 0 / 0
22.12.2008, 14:20
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35728063
_slan_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_slan_
Участник
A-NikДа, KL, метод Уокенбаха, честно сказать, меня только рассмешил Кстати, метод с ранним связыванием - тоже :-) Не ожидал такой скорости работы :-)
Единственное, что могу предложить, так это ещё немного оптимизировать цикл для варианта с коллекцией:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Private Sub CommandButton4_Click()
Dim arr, arr1, x, c As New Collection, t As Single
  Columns( 2 ).ClearContents
  t = Timer
  On Error GoTo erm
  Application.ScreenUpdating = False
  arr = Range(Cells( 2 ,  1 ), Cells(Rows.Count,  1 ).End(xlUp))
  ReDim arr1( 1  To UBound(arr),  1  To  1 )
  For Each x In arr
    c.Add  0 , CStr(x)
    arr1(c.Count,  1 ) = x
nxt: Next
  Cells( 2 ,  2 ).Resize(c.Count) = arr1
  [CalcTime] = Timer - t
  Exit Sub
erm: Resume nxt
End Sub
Здесь можно было бы просто сделать On Error Resume Next , но так оказывается чуть дольше :-) (заменто на 65000 строках)

:)

я тоже уже проверил:
Private Sub CommandButton2_Click()
Dim l&, lm&
lm = [steps]
Columns(2).ClearContents
Dim arr, arr2(), x, c As New Collection, t As Single, i&
Application.ScreenUpdating = False
t = Timer
For l = 1 To lm
With Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
arr = .Value
ReDim arr2(1 To UBound(arr), 1 To 1)
On Error GoTo erm
For Each x In arr
c.Add 0, CStr(x)
i = i + 1
arr2(i, 1) = x
erm: Resume nxt
nxt: Next
.Offset(, 1).Resize(c.Count) = arr2
End With
Next
Range("CalcTime") = Timer - t
End Sub
чуть быстрее, чем у ZVI, но раннему связыванию все же уступает.. вдвое примерно?
...
Рейтинг: 0 / 0
22.12.2008, 15:17
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35728081
_slan_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_slan_
Участник
и, кстати, при увеличении числа повторов(а это, мне кажется, вполне вероятно в реальности) использование on error goto даст еще больший выигрыш
...
Рейтинг: 0 / 0
22.12.2008, 15:24
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35728090
_slan_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_slan_
Участник
_slan_,
а если все это полностью на С сделать...

вот только удивляюсь - почему же расширенный фильтр так тормозит?
...
Рейтинг: 0 / 0
22.12.2008, 15:27
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35728317
A-Nik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
A-Nik
Гость
ZVIТак метод с ранним связыванием тоже рассмешил или порадовал? :-)И то и другое :-) И с поздним связываением тоже :-)
Ну где ещё придумаешь такое кол-во вариантов, как не в экселе! :-) Уже можно со счёту сбиться :-)
...
Рейтинг: 0 / 0
22.12.2008, 16:45
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35728499
f
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
f
Участник
Вот чего только мозг программиста не выдумает, чтобы на нормальную СУБД не переходить!
...
Рейтинг: 0 / 0
22.12.2008, 17:53
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35728626
ZVI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ZVI
Участник
_slan__slan_,
а если все это полностью на С сделать...

вот только удивляюсь - почему же расширенный фильтр так тормозит?
При больших масcивах и оптимизированном VBA-коде тормозит уже не VBA, а объекты Collection или Dictionary, которые. насколько я понимаю, на С++ писаны.

Кстати, скорость кода, скомпилирована на С не всегда выше VBA - зависит от компилятора и от кода. Можно, например. функциями VBA написать код, который работает в 3-раза быстрее, чем встроенная в VBA (С++ компилированная) функция Replace(). На определенных тестах, конечно.
...
Рейтинг: 0 / 0
22.12.2008, 18:33
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35728764
_slan_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_slan_
Участник
интерпретация по определению не может быть быстрее компиляции..

значит разница в алгоритме..

возможно перегруженность проверками надежности..

после каждого действия assert.. :) попробовать что-ли записать алгоритм на С++ ?..
...
Рейтинг: 0 / 0
22.12.2008, 19:34
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35728864
_slan_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_slan_
Участник
а с коллекциями, по-моему, все. Оптимизировано до конца:

Function unic(src As Range, Optional dest As Range) As Long
Dim arr, x, c As New Collection
arr = src.Value
On Error GoTo erm
For Each x In arr
c.Add 0, CStr(x)
arr(c.Count, 1) = x
nxt: Next
On Error GoTo 0
If Not dest Is Nothing Then dest.Resize(c.Count) = arr
unic = c.Count
Exit Function
erm: Resume nxt
End Function


или нет? :)
...
Рейтинг: 0 / 0
22.12.2008, 20:57
| Ответить | Цитировать | Написать  
Узнать все доступные значения при установке автофильтра
    #35728872
_slan_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_slan_
Участник
:)

а точнее так:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
Function unic(src As Range, Optional dest As Range) As Long
  Dim arr, x, c As New Collection
    arr = src.Value
    If dest Is noting Then
        On Error Resume Next
        For Each x In arr
            c.Add  0 , CStr(x)
        Next
        On Error GoTo  0 
    Else
        On Error GoTo erm
        For Each x In arr
            c.Add  0 , CStr(x)
            arr(c.Count,  1 ) = x
nxt:    Next
        On Error GoTo  0 
        dest.Resize(c.Count) = arr
    End If
    unic = c.Count
    Exit Function
erm:   Resume nxt
End Function
...
Рейтинг: 0 / 0
22.12.2008, 21:06
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
Узнать все доступные значения при установке автофильтра
    #36680409
Дмитрий-(сколько-же-нас?)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий-(сколько-же-нас?)
Гость
Возникла такая же задача.
Подправил код для возврата коллекции:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Function unic(src As Range) As Collection
  Dim arr, x, c As New Collection
    arr = src.Value
        On Error GoTo erm
        For Each x In arr
            c.Add  0 , CStr(x)
            arr(c.Count,  1 ) = x
nxt:    Next
        On Error GoTo  0 
    unic = c
    Exit Function
erm:   Resume nxt
End Function
Ругается на строку unic = c :
Compile error:
Argument not optional
С чем связана такая ошибка?
...
Рейтинг: 0 / 0
10.06.2010, 12:58
| Ответить | Цитировать | Написать  
25 сообщений из 78, страница 3 из 4
  3  все
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Узнать все доступные значения при установке автофильтра
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&msg=35724448&tid=2178000]:
 0ms
get settings:
 7ms
get forum list:
 14ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 162ms
get topic data:
 7ms
get forum data:
 1ms
get page messages:
 60ms
get tp. blocked users:
 1ms
others: 222ms
total:  480ms
созд. / загр.: 480ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]