Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.12.2014, 16:07   #1
kievlyanin
Форумчанин
 
Регистрация: 21.04.2008
Сообщений: 110
По умолчанию помогите ускорить макрос (выборка уникальных по 2-м условиям)

PHP код:
Sub test()

For 
1 To ActiveSheet.PivotTables("ÑâîäíàÿÒàáëèöà1").PivotFields("Îáúåêò").PivotItems.Count
If ActiveSheet.PivotTables("ÑâîäíàÿÒàáëèöà1").PivotFields("Îáúåêò").PivotItems(i).Visible True _
Then gitem 
ActiveSheet.PivotTables("ÑâîäíàÿÒàáëèöà1").PivotFields("Îáúåêò").PivotItems(i): Exit For
Next i


ReDim argfld
(11)

With Sheets("BD")
For 
2 To .Cells(400000"A").End(xlUp).Row

If (.Cells(i"B") = gitem And .Cells(i"A") = "1C_fakt"_
Or (.Cells(i"B") = gitem And .Cells(i"A") = "po_aktam_fakt"_
Or (.Cells(i"B") = gitem And .Cells(i"A") = "Ïëàí"Then

For ii 1 To UBound(argfld2)

If .
Cells(i"F").Value argfld(1iiThen Exit For

If 
ii UBound(argfld2Then
ReDim Preserve argfld
(1UBound(argfld2) + 1)
argfld(1UBound(argfld2)) = .Cells(i"F").Value
End 
If
Next ii

End 
If

Next i
End With




End Sub 


код рабочий но с увеличением базы начал слишком долго думать - как можно его оптимизировать/ускорить?
kievlyanin вне форума Ответить с цитированием
Старый 10.12.2014, 17:02   #2
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

может так:
Код:
Sub test()
  Dim s As String
  For i = 1 To ActiveSheet.PivotTables("NaiaiayOaaeeoa1").PivotFields("Iauaeo").PivotItems.Count
    If ActiveSheet.PivotTables("NaiaiayOaaeeoa1").PivotFields("Iauaeo").PivotItems(i).Visible = True _
    Then gitem = ActiveSheet.PivotTables("NaiaiayOaaeeoa1").PivotFields("Iauaeo").PivotItems(i): Exit For
  Next i
  With Sheets("BD")
    For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
      If .Cells(i, "B") = gitem And InStr("1C_faktpo_aktam_faktIeai", .Cells(i, "A")) > 0 Then
        If InStr(s, .Cells(i, "F")) = 0 Then s = s & .Cells(i, "F") & Chr(9)
      End If
    Next i
  End With
  argfld = WorksheetFunction.Transpose(Split(s, Chr(9)))
End Sub
только все это
NaiaiayOaaeeoa1, Iauaeo, Ieai
замените на кириллицу
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 10.12.2014, 17:18   #3
kievlyanin
Форумчанин
 
Регистрация: 21.04.2008
Сообщений: 110
По умолчанию

да .. быстрее .. а такой вопрос - при увеличении базы еще более значительно .. например раза в два-три (сечас 100 тыс строк) .. будт ли быстрее если работать не с самим листом (With Sheets("BD")....) а загонять обрабатываемый диапазон в переменную?
kievlyanin вне форума Ответить с цитированием
Старый 10.12.2014, 17:32   #4
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

можно все посортировать по колонке В
найти первый gitem, найти количество gitem
в итоге обрабатываете не весь массив, а только нужные строки
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 11.12.2014, 10:48   #5
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Если работать не с ячейками, а с массивом этих данных - будет быстрее в 43 раза. Я замерял
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Создание списка уникальных значений по условиям Gobaith Microsoft Office Excel 11 05.07.2012 23:13
Выборка значений по двум условиям Stefav Microsoft Office Excel 6 16.03.2010 13:34
отбор уникальных значений по определенным условиям Alex___ Microsoft Office Excel 39 12.10.2009 17:02
выборка уникальных значений из бд MsSQL xxxsas SQL, базы данных 1 11.04.2009 14:31
Выборка уникальных значений Mary_star SQL, базы данных 9 11.02.2008 22:46