Excel ускорить работу макроса vba excel

Хитрости »

20 Январь 2016              61472 просмотров

---

Рано или поздно у пишущих на Visual Basic for Applications возникает проблема — код хоть и облегчает жизнь и делает все автоматически, но очень долго. В этой статье я решил собрать несколько простых рекомендаций, которые помогут ускорить работу кода VBA, при этом в некоторых случаях весьма внушительно — в десятки, а то и больше, раз. Основной упор в статье сделан на начинающих, поэтому в начале статьи приводятся самые простые методы оптимизации. Более «глубокие» решения по оптимизации кода приведены в конце статьи, т.к. для применения данных решений необходим достаточный опыт работы в VB и сходу такие методы оптимизации кому-то могут быть непонятны.

1. Если в коде есть много всяких Activate и Select, тем более в циклах — следует немедленно от них избавиться. Как это сделать я писал в статье: Select и Activate — зачем нужны и нужны ли?
2. Обязательно на время выполнения кода отключить:
   • автоматический пересчет формул. Чтобы формулы не пересчитывались при каждой манипуляции на листе во время выполнения кода — это может дико тормозить код, если формул много:

     Application.Calculation = xlCalculationManual

     Если во время кода все же нужно пересчитывать какие-то диапазоны, то можно пересчитывать только их:

     Range("A1:C60").Calculate

   • обновление экрана, чтобы действия по изменению значений ячеек и пр. не мелькали. Зачем это надо? Т.к. все эти действия обращаются к графическому процессору и заставляют его трудиться для перерисовки экрана — это может значительно тормозить код:

     Application.ScreenUpdating = False

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

     Application.EnableEvents = False

   • Если книга выводилась на печать или выводится на печать в процессе выполнения кода, то лучше убрать разбиение на печатные страницы.

     ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False

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

   • На всякий случай можно отключить отображение информации в строке статуса Excel(в каких случаях там вообще отображается информация и зачем можно узнать в статье: Отобразить процесс выполнения). Хоть это и не сильно поедает ресурсы — иногда может все же ускорить работу кода:

     Application.StatusBar = False

   Главное, что следует помнить — все эти свойства необходимо включить обратно после работы кода. Иначе могут быть проблемы с работой внутри Excel. Например, если забыть включить автопересчет формул — большинство формул будут пересчитывать исключительно принудительным методом — после нажатия сочетания клавиш Shift+F9. А если забыть отключить обновление экрана — то есть шанс заблокировать себе возможность работы на листах и книгах. Хотя по умолчанию свойство ScreenUpdating и должно возвращаться в True, если было отключено внутри процедуры — лучше не надеяться на это и привыкать возвращать все свойства на свои места принудительно. По сути все это сведется к нескольким строкам:

   'Возвращаем обновление экрана
   Application.ScreenUpdating = True
   'Возвращаем автопересчет формул
   Application.Calculation = xlCalculationAutomatic
   'Включаем отслеживание событий
   Application.EnableEvents = True

   Как такой код выглядит на практике. Предположим, надо записать в цикле в 10 000 строк значения:

   Sub TestOptimize()
   'отключаем обновление экрана
   Application.ScreenUpdating = False
   'Отключаем автопересчет формул
   Application.Calculation = xlCalculationManual
   'Отключаем отслеживание событий
   Application.EnableEvents = False
   'Отключаем разбиение на печатные страницы
   ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False
    
   'Непосредственно код заполнения ячеек
   Dim lr As Long
   For lr = 1 To 10000
       Cells(lr, 1).Value = lr 'для примера просто пронумеруем строки
   Next
    
   'Возвращаем обновление экрана
   Application.ScreenUpdating = True
   'Возвращаем автопересчет формул
   Application.Calculation = xlCalculationAutomatic
   'Включаем отслеживание событий
   Application.EnableEvents = True
   End Sub

   Разрывы печатных страниц можно не возвращать — они тормозят работу в любом случае.

3. Следует избегать циклов, вроде Do While для поиска последней ячейки. Часто такую ошибку совершают начинающие. Куда эффективнее и быстрее вычислять последнюю ячейку на всем листе или в конкретном столбце без этого тормозного цикла Do While. Я обычно использую

   lLastRow = Cells(Rows.Count,1).End(xlUp).Row

   другие варианты определения последней ячейки я детально описывал в статье: Как определить последнюю ячейку на листе через VBA?

Для более опытных пользователей VBA я приведу несколько решений по оптимизации кодов в различных ситуациях:

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

  Sub TestOptimize_Array()
  'Непосредственно код заполнения ячеек
  Dim arr, lr As Long
  'запоминаем в массив одним махом все значения 10000 строк первого столбца
  arr = Cells(1, 1).Resize(10000).Value
  'если нужно заполнение для двух и более столбцов
  'arr = Cells(1, 1).Resize(10000, 2).Value
  'или 
  'arr = Range(Cells(1, 1),Cells(10000, 2)).Value
  'или автоматически вычисляем последнюю ячейку и заносим в массив данные, начиная с ячейки А3
  'llastr = Cells(Rows.Count, 1).End(xlUp).Row 'последняя ячейка столбца А
  'arr = Range(Cells(3, 1),Cells(llastr, 2)).Value
  For lr = 1 To 10000
      arr(lr,1) = lr 'заполняем массив порядковыми номерами
  Next
  'Выгружаем обработанный массив обратно на лист в те же ячейки
  Cells(1, 1).Resize(10000).Value = arr
  End Sub

  Но здесь следует учитывать и тот момент, что большие массивы могут просто вызвать переполнение памяти. Наиболее актуально это для 32-битных систем, где на VBA и Excel выделяется памяти меньше, чем в 64-битных системах

• Если используете быстрый ЕСЛИ — IIF, то замените его на IF … Then … Else
• Так же лучше вместо Switch() и Choose() применить тот же IF … Then … Else
• В большинстве случаев проверять строку на «не пусто» лучше через Len(), чем прямое сравнение с пустотой: Len(s)=0 вместо s = «». Связано с тем, что работа со строками значительно медленнее, чем с числовыми данными и Len по сути не подсчитывает длину переменной, а берет это число непосредственно уже готовое из памяти. При сравнении же текста с пустой строкой(«»), VBA сначала создает в памяти переменную нулевой длинны, а уже потом сравнивает с ней наш текст. Поэтому в некоторых случаях так же ускоряет сравнение и в таком виде: s = vbNullString
• Не применять объединение строк без необходимости. Например, s = «АВ», будет быстрее, чем: s =»А» & «В»
• Не применять сравнение текстовых величин напрямую. Лучше применить встроенную функцию StrComp:
  If s <> s1 Then будет медленнее, чем
  If StrComp(s, s1, vbBinaryCompare) <> 0
  и тем более, если при сравнении необходимо не учитывать регистр:
  If LCase(s) <> LCase(s1) Then будет медленнее, чем
  If StrComp(s, s1, vbTextCompare) <> 0
• Циклы For … Next в большинстве случаев работает быстрее, чем цикл Do … Lоор
• Избегать присвоения переменным типа Variant. Хоть соблазн и велик — этот тип забирает много памяти и в дальнейшем замедляет работу кода. Так же для объектных переменных следует избегать по возможности безликого глобального типа Object и применять конкретный тип:

  Dim rRange as Object, wsSh as Object

  будет медленнее работать, чем:

  Dim rRange as Range, wsSh as Worksheet

  Причина в том, что при объявлении As Object мы не даем VBA практически никакой информации о типе данных, кроме того, что это какой-то объект. И VBA приходится «на лету» внутри кода при каждом обращении к такой переменной определять её конкретный тип(Range, Worksheet, Workbook, Chart и т.д.). Что опять же занимает время.

• Если работаете с массивами, то можно при объявлении указать это явно:

  вместо

  Такая инициализация происходит быстрее.
  А еще лучше будет при этом еще и тип данных сразу присвоить:

  Dim arr() as string, arr2() as long

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

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

---

Статья помогла? Поделись ссылкой с друзьями!

    Видеоуроки

---

Поиск по меткам



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика

As part of our work to help enterprises upgrade to Office 365 ProPlus, we have found that some users have been experiencing slow running VBA, which can be frustrating. The good news is that there are steps which can be taken to improve performance.

This post aims to raise awareness of the steps that you can take to improve the performance of your macros, whether you are an end user, IT admin, or developer. We’ve collected the following steps from blog posts, Microsoft field engineers, and Microsoft MVPs like Charles Williams and Jan Karel Pieterse.

1. Turn off everything but the essentials in VBA

One of the first things to do when speeding up VBA code is to turn off unnecessary features such as animations, screen updating, automatic calculations and events while your macro is running. These features can add extra overhead and slow down the macro, particularly if the macro is modifying many cells and triggering lots of screen updates and recalculations.

The below code sample shows you how to enable/disable:

• Manual calculations
• Screen updates
• Animations

Option Explicit
Dim lCalcSave As Long
Dim bScreenUpdate As Boolean
Sub SwitchOff(bSwitchOff As Boolean)
  Dim ws As Worksheet
    
  With Application
    If bSwitchOff Then 

      ' OFF 
      lCalcSave = .Calculation
	bScreenUpdate = .ScreenUpdating
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
      .EnableAnimations = False
      
      '
      ' switch off display pagebreaks for all worksheets
      '
      For Each ws In ActiveWorkbook.Worksheets
        ws.DisplayPageBreaks = False
      Next ws
    Else
 
      ' ON
      If .Calculation <> lCalcSave And lCalcSave <> 0 Then .Calculation = lCalcSave
      .ScreenUpdating = bScreenUpdate
      .EnableAnimations = True
      
    End If
  End With
End Sub

Sub Main()
  SwitchOff(True) ‘ turn off these features
  MyFunction() ‘ do your processing here
  SwitchOff(False) ‘ turn these features back on
End Sub

2. Disabling Office animations through system settings

Animations can be disabled across Windows by accessing the Ease of Access Center.

Animations can be disabled in Excel specifically, under the Advanced or Ease of Access tab, within the File > Options menu.

Please see the following link for more information: https://support.office.com/en-us/article/turn-off-office-animations-9ee5c4d2-d144-4fd2-b670-22cef9fa…

3. Disabling Office animations through registry settings

Office animations can be disabled across multiple computers by setting the appropriate registry key via a group policy setting.

HIVE: HKEY_CURRENT_USER
Key Path: SoftwareMicrosoftOffice16.0CommonGraphics
Key Name: DisableAnimations
Value type: REG_DWORD
Value data: 0x00000001 (1)

Warning: Using Registry Editor incorrectly can cause serious, system-wide problems that may require you to re-install Windows to correct them. Microsoft cannot guarantee that any problems resulting from the use of Registry Editor can be solved. Use this tool at your own risk.

4. Removing unnecessary selects

The select method is common to see in VBA code, however it is often added to the macro where it isn’t needed. Select can trigger cell events such as animations and conditional formatting which slow the macro down, so removing unnecessary selects can significantly speed up your macro.

The following example shows the code before and after making the change to remove unnecessary selects.

Before

Sheets("Order Details").Select
Columns("AC:AH").Select
Selection.ClearContents

After

Sheets("Order Details").Columns("AC:AH").ClearContents

5. Using the With statement to read object properties

When working with objects, use the With statement to reduce the number of times object properties are read. The following example shows the code before and after making the change to use the With statement.

Before

Range("A1").Value = “Hello”
Range("A1").Font.Name = “Calibri”
Range("A1").Font.Bold = True
Range("A1").HorizontalAlignment = xlCenter

After

With Range("A1")
  .Value2 = “Hello” 
  .HorizontalAlignment = xlCenter
    With .Font
      .Name = “Calibri”
      .Bold = True
    End With
End With

6. Using ranges and arrays

Reading and writing to cells in Excel from VBA is expensive. There is an overhead that is incurred every time data moves between VBA and Excel.

The mountain between Excel and VBA

This means that you should try to reduce the number of times you pass data between VBA and Excel. This is where ranges are useful. Instead of reading and writing to each cell individually in a loop, read the entire range into an array at the start, loop through the array, and then write the entire array back at the end. The following example code shows how a range can be used to read and write the values once, instead of reading each cell individually.

Dim vArray As Variant
Dim iRow As Integer
Dim iCol As Integer
Dim dValue As Double
vArray = Range("A1:C10000").Value2 ‘ read all the values at once from the Excel cells, put into an array 

For iRow = LBound(vArray, 1) To UBound(vArray, 1)
  For iCol = LBound(vArray, 2) To UBound(vArray, 2)
    dValue = vArray (iRow, iCol)
    If dValue > 0 Then 
      dValue=dValue*dValue ‘ Change the values in the array, not the cells 
    vArray(iRow, iCol) = dValue
  End If
Next iCol
Next iRow
Range("A1:C10000").Value2 = vArray ‘ writes all the results back to the range at once

7. Use .Value2 instead of .Text or .Value

There are different ways that you can retrieve values from a cell, and which property you use can make a different in the performance of your code.

.Text is commonly used to retrieve the value of a cell – it returns the formatted value of a cell. Getting the formatting of a cell is more complex than just retrieving a value, and makes .Text quite slow.

.Value is an improvement over .Text, as this mostly gets the value from the cell, without formatting. However for cells formatted as a date or currency, .Value will return a VBA date or VBA currency (which may truncate decimal places).

.Value2 gives the underlying value of the cell. As it involves no formatting, .Value2 is faster than .Value. .Value2 is faster than .Value when processing numbers (there is no significant difference with text), and is much faster using a variant array.

For a more detailed explanation, please see Charles William’s blog post, “TEXT vs VALUE vs VALUE2”: https://fastexcel.wordpress.com/2011/11/30/text-vs-value-vs-value2-slow-text-and-how-to-avoid-it/

8. Bypass the clipboard (copy and paste)

When you use the Macro Recorder to record operations that use copy and paste, the code will use the copy and paste methods by default. However, within VBA code, it is much faster to bypass the clipboard and use internal operations instead. By default, copying will copy everything, including formulas, values and formatting. You can make copying faster by only copying values or formulas, without the formatting. The following example shows the code before and after making the change to bypass the clipboard.

Before

Range("A1").Select
Selection.Copy
Range("A2").Select
ActiveSheet.Paste

After

‘ Approach 1: copy everything (formulas, values and formatting
Range("A1").Copy Destination:=Range("A2")

‘ Approach 2: copy values only
Range("A2").Value2 = Range("A1").Value2

‘ Approach 3: copy formulas only
Range("A2").Formula = Range("A1").Formula

If you still find that a macro takes longer than expected to execute many individual copy and paste operations, you may want to apply the following hot fix: https://support.microsoft.com/en-in/help/2817672/macro-takes-longer-than-expected-to-execute-many-in…

9. Use Option Explicit to catch undeclared variables

Option Explicit is one of the available Module directives in VBA that instructs VBA how to treat the code within the code module. Setting Option Explicit requires all variables to be declared and will give compile errors if an undeclared variable is used. This helps catch incorrectly typed variable names and improves performance with all variable types being defined at compile time, instead of being inferred at runtime.

This can be set by typing: Option Explicit at the top of each module in your project or by checking the «Require Variable Declaration» option under Tools -> Options in the VBA editor. 

Additional Details on Module directives can be found here: https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/option-explicit-s…

Conclusion

We hope that this has helped highlight some of the ways that you can make your macros run faster. We’re sure that we haven’t covered everything, so please comment below with any other tips or tricks to improve the performance of your macros in Excel.

Further reading

https://blogs.office.com/en-us/2009/03/12/excel-vba-performance-coding-best-practices/

http://datapigtechnologies.com/blog/index.php/ten-things-you-can-do-to-speed-up-your-excel-vba-code/

https://www.ozgrid.com/VBA/SpeedingUpVBACode.htm

FAQs:

After using the new macro animations stopped working/it’s stuck on manual calculation.

It is possible the code disables the various settings, but the macro crashes before re-enabling these settings. To fix this, you will need to run the code to enable these settings again.

Other resources

https://www.thespreadsheetguru.com/blog/2015/2/25/best-way-to-improve-vba-macro-performance-and-prev… — The Best Way To Improve VBA Macro Performance And Prevent Slow Code Execution

https://www.ozgrid.com/VBA/SpeedingUpVBACode.htm — Optimize Slow VBA Code. Speeding Up Slow Excel VBA Code

About the co-authors

Charles Williams founded Decision Models in 1996 to provide advanced consultancy, decision support solutions, and tools based on Microsoft Excel and relational databases. Charles is the author of FastExcel, the widely used Excel performance profiler and performance toolset, and co-author of Name Manager, the popular utility for managing defined names. For more information about Excel calculation performance and methods, memory usage, and VBA user-defined functions, visit the Decision Models Web site.

Jan Karel Pieterse is a long time Excel MVP who develops custom solutions focused on Microsoft Office, with deep expertise in Excel and VBA. He runs the website JKP Application Development Services site, where you can find an interesting collection of articles, training events, and utilities. For a good overview of topics, see this list of in-depth articles. Jan develops some cool and useful utilities for Excel, including NameManager, RefTreeAnalyser, and Flexfind. You can find a full list on the downloads page.

 

Если вы хотите, чтобы ваш код макроса VBA работал быстро, то необходимо отключить некоторые функции VBA Excel в начале кода. После выполнения макроса снова включаем все функции.
Для этого мы можно использовать следующий код:

' Процедура : TurnOffFunctionality
' Источник  : www.planacademy.ru
' Назначение: Отключает автоматические вычисления, обработку событий и обновление экрана
Public Sub TurnOffFunctionality()
    ' Все расчеты переводим в ручной режим
    Application.Calculation = xlCalculationManual
    ' Отключаем статусную строку
    Application.DisplayStatusBar = False
    ' Отключаем события
    Application.EnableEvents = False
    '  Отключаем показ разбиения листа на печатные страницы 
    If Workbooks.Count Then
      ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False 
    End If
    ' Больше не обновляем страницы после каждого действия  
    Application.ScreenUpdating = False
    ' Отключаем сообщения Excel
    Application.DisplayAlerts = False 
End Sub

' Процедура : TurnOnFunctionality
' Источник  : www.planacademy.ru
' Purpose   :  Включает автоматические вычисления, обработку событий и обновление экрана 
Public Sub TurnOnFunctionality()
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
     If Workbooks.Count Then
      ActiveWorkbook.ActiveSheet.DisplayPageBreaks =  True 
    End If 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Использовать эти процедуры можно следующим образом:

Sub Main()

    ' Выключить вначале
    TurnOffFunctionality
    
    ' Ваш основной код здесь
    
    ' Включить в конце
    TurnOnFunctionality

End Sub

Иногда, когда выполняется макрос, процедура не доходит до строки включения функций “TurnOnFunctionality”. Это может произойти из-за ошибки или из принудительной остановки кода в определенный момент. Если это произойдет, вы можете снова включить все функции, выбрав процедуру TurnOnFunctionality в окне радактирования кода и нажав клавишу F5.

Никогда не используем функцию Select

При копировании данных в Excel VBA не используйте метод Select-никогда! Большая ошибка, которую делают новички VBA, – это думают, что им нужно выбрать ячейку или диапазон, прежде чем ее скопируют.
Например:

shRead.Activate
shRead.Range("A1").Select
shWrite.Activate
Selection.Copy Activate.Range("H1")

Помните об этих двух важных вещах, прежде чем используется VBA для копирования данных:

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

Часто можно увидеть, что Select используется во многих примерах в интернете. Но вам не нужно использовать его для копирования ячеек – никогда!

Общие рекомендации

Оптимизация
1) Желательно избегать формул массивов (по возможности)
2) Избегать волатильных формул (по возможности) (условное форматирование, как пример волатильности)
3) Использовать структурированные таблицы и именованные диапазоны
4) Заменять неиспользуемые формулы значениями
5) Хранить все данные для расчета на одном листе (по возможности)
6) Избегать в формулах ссылки на целые столбцы
7) использовать =IFERROR вместо IF + ISERR/ISERROR
использовать MAX(A1;0) вместо IF(A1>0;A1;0)
9) использовать INDEX+MATCH вместо VLOOKUP
10) использовать — для конвертации лог.значение в 0/1
11) использовать A1*0.1 чем A1/10
VBA
12) Использовать оператор if else, вместо IIF
13) Использовать Long т.е. Long лучше Вуte, Integer, конечно, variant
14) Применять if else, чем switsh; shoose
15) Лучше проверять строку так len(s)=0, чем s = “”
16) Лучше инициализировать строку так s =vbnullstring, чем s =””
17) Если возможно писать так s = “АВ”, чем s =”А” & “В”
18) Вставлять строку в текст так Мid$(а,3,4)=”like”. чем s = left$(8,2) & “like” & mid(з,7)
19) Сравнивать строки так if strcomp(s1,s2,vbtextcompare) =0, чем if ucase(s1)=ucase(s2)
20) Лучше использовать $-функцию, т.е. left$ лучше left.
21) Цикл for …next. работает быстрее do…lоор
22) Точнее объявлять объекты: as commandbutton лучше as control, еще лучше as object
23) Цикл for Еасh..next лучше, чем цикл for…next семейств объектов
24) Цикл for …next лучше, чем цикл fог Еасh…next: для массивов.
25) Использовать оператор With при обращении к элементам сходной иерархической модели
Для общих (расшаренных) книг
26) Удалять пользовательские представления Вид-Представления-Удалить
27) Снять пометки с Параметров печати и Фильтров , так Рецензирование-Доступ к книге-Параметры печати и Фильтры
28) Периодически отключать общий доступ, сохранять книгу, отключать общий доступ и снова сохранять
29) Удостовериться, что книга открывается в режиме просмотра Вид-Обычный (для того, чтобы избежать обращения к сетевому принтеру с соответствующими временными последствиями)
30) Перелить одну книгу в другую путем копирования не листа, а содержимого в новую книгу со вставкой сначала значения, потом формулы, потом форматы и макросы через импорт экспорт перенести в новую книгу
31 ) Удалить избыточное форматирование

Ускорение работы макросов

​Смотрите также​​ Next i ActiveSheet.Cells(2,​
​.​ во всей книге?»,​Application.CutCopyMode = False​ не факт что​
​ работать средствами VBA​If Колонка2(i, 1)​Вернее, сначала снять​ CurR = CurR​ результат печальный, тк​.SortMethod = xlPinYin​ :​: vikttur, прочитав правила​For i =​ на множество ячеек.​ работает оптимальнее? Насколько​ann_sergeevna​ ncolumn).Resize(UBound(arr2), UBound(arr2, 2))​Цитата​ vbYesNo) = vbNo​Selection.AutoFill Destination:=Range(Cells(1, 2),​ будут повторные значения​ — придется много​ записал бы If​ с листа (листов)​
​ + yes Next​

​ на 10 записях​​.Apply​200?’200px’:»+(this.scrollHeight+5)+’px’);»> x = r.CurrentRegion.Value​ ещё раз, я​ 0 To UBound(Arr)​Но опять же:​ знаю, принцип работы​
​: Всем добрый вечер.​ = arr2’вываливаем на​китин, 28.07.2016 в​
​ Then​ Cells(1, lLastCol)), Type:=xlFillDefault​ в вырезанном диапозоне.​ править (уж много​ v = «»​ данные, проделать необходимые​ j, i End​ уходит 20 сек.​

​End With​​на обращение к​ нашел только о​
​If .Item(Arr(i)) Then​ все всегда зависит​ у них одинаковый.​Вот решила поинтересоваться,как​ лист Application.ScreenUpdating =​ 16:13, в сообщении​If Selection.Count =​ ‘копируем на весь​AlexM​ условий с ссылками​ And Колонка2(i, 1)​ данные и сбросить​ With Полное_Ускорение 1​ Но это из​End With​ большому массиву, но​ том, что желательно​ .Remove Arr(i)​ от конкретной ситуации​ Вопрос может быть​ профи справляются с​ True End SubА​ № 13200?’200px’:»+(this.scrollHeight+5)+’px’);»>могут и​ 1 Then Set​ диапазон​: Фрагмент правил форума​ на таблицы).​ Но это на​ результаты на лист​ ‘Выключаем полное ускорение​ за костылей. А​miver​ тогда есть что​

​ выкладывать пример, но​​Next​ и порой там,​ только в размере​ проблемой очень медленной​ то 2 массива:​ часто.​ r = ActiveSheet.UsedRange​Range(Cells(1, 2), Cells(1,​Рекомендации по составлению примера​​Скажите, а если​ любителя, хотя пару​ (листы).​ End Sub Sub​ знающие люди не​: Добавлю пример без​ еще дописывать​

​ в прилепленном файле​​If .Count Then​ где одно быстрее​ ссылок на массив​ работы макросов?​

​ один 69тыс, второй​​так не договаривались​ Else Set r​
​ lLastCol)).Select​- Обычно, чтобы​

​ сделать так:​​ операторов в цикле​особенно этот эффект​ RWord(Range As Range)​ хотят делиться секретом​ рекурсии​

​ikki​​ и пример и​​Arr = .keys​
​ — другое будет​
​ данных. Но этот​у меня файл​
​ 500тыс сравнивались друг​ . В примере​ = Selection​Selection.Copy ‘ копируем​
​ понять и помочь​Я применю автофильтр,​ убирает.​
​ заметен на больших​ ‘ ‘Случайное слово​
​ красоты, чтоб ускорить​ZamoK​: рекурсивный алгоритм.​ сам макрос. Не​
​If UBound(Arr) <​ медленнее.​ вопрос одинаково справедлив​
​ загружен макросами и​ с другом 6​ такого нет -​
​r.Replace 0, «»,​Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,​
​ — достаточно таблицы​ выделю видимые данные,​
​И еще. Мне​ табюлицах.​ с точкой и​
​ в 2 раза.​: Все отлично, красиво.​
​перебор дерева состава.​
​ понимаю, что сделал​ 63000 Then​e_artem​
​ для обеих функций.Цитатаe_artem​ формулами(это по своей​ часов, что мягко​ давайте пример с​
​ xlWhole​ SkipBlanks _​ на 10-20 строк.​
​ и вставлю их​ проверять лень, что​Попробуйте сравнить время​ цифрой ‘ Dim​
​fever brain​ Спасибо!​имхо, сильно зависит​ не так) Лучше​
​Range(«B1»).Resize(UBound(Arr) + 1)​: В конечном счете​ написал:​ сути автоматизированный калькулятор).Есть​ говоря очень медленно.​
​ такими дублями.​Else​:=False, Transpose:=False ‘вставляем​- Но при​ в отдельный лист​
​ работает быстрее, но​ выполнения:​ i&, j&, s$​, не, это не​
​blackeangel​ от реальных данных.​ было бы сам​
​ = WorksheetFunction.Transpose(Arr)​ получается, что вышеописанное​использовать — для​
​ макрос очистки полей,который​Hugo121​Manyasha​For Each sh​ значения​
​ этом старайтесь сохранить​ (созданный специально для​ почему бы не​Кликните здесь для​
​ s = Space(20)​ про меня. Нет​: Как ускорить работу​откуда я знаю​
​ пример выложить в​Else​ это не инструкции​ конвертации лог.значение в​
​ закреплён за кнопкой​: Привлекайте коллекцию или​
​: потому что меня​ In ActiveWorkbook.Sheets​
​Sheets(«состав»).Range(«B2»).FormulaLocal = «=СУММПРОИЗВ(План!$P$18:$GA$800*(План!$P$16:$GA$16=»»СБ»»)*(План!$P$15:$GA$15=состав!$A2)*(состав!B$31=План!$C$18:$C$800))»​ структуру, расположение таблиц,​ вычислений). Так у​ навесить реальный автофильтр?​ просмотра всего текста​ For i =​
​ времени ходить пить​ скрипта?​ — может, в​ текст сообщения?​ReDim mArr(UBound(Arr), 0)​
​ к действию на​ 0/1тоже не всегда​ очистки,есть макрос печати​ словарь.​ переклинило, я решила,​Set r =​ ‘вставляем формулу в​
​ имена листов -​ меня получится таблица​Range(«A3:E1500»).Select​ Код [VB]Option Explicit​ 1 To 3​ кофе. Есть куча​Sub test() Dim​ реале уровень вложенности​ikki, да, вы​For i =​ случай проблем производительности,​ справедливо. Все зависит​ с заданными параметрами,есть​Больше без собственно​ что это диапазон​ sh.UsedRange​
​ 2 строку​ аналогично оригиналу.​

​ только с нужными​Selection.AutoFilter​ Const M =​ Mid$(s, i, 1)​ параллельных задач. Так​ arr1() Application.ScreenUpdating =​ узлов в разы​ правы, признаю -​ 0 To UBound(Arr)​ а моменты на​ от конкретной формулы​ макрос,который учитывает условия​ задачи и данных​ 2-го листа​
​r.Replace 0, «»,​Range(«B2»).Select​- Если файл​ мне строками (Или​Selection.AutoFilter Field:=1, Criteria1:=»<>»​ 500 Const N​ = Chr(97 +​ что на это​ False ‘range и​ или десятки раз​ я тут немного​mArr(i, 0) =​
​ которые стоит обратить​ и ситуации, это​ и в зависимости​​ не скажу, голову​Ярослав, спасибо за​ xlWhole​Selection.AutoFill Destination:=Range(«B2:B29»), Type:=xlFillDefault​ содержит конфиденциальную информацию​ же я смогу​Selection.AutoFilter Field:=6, Criteria1:=»​ = 200 Public​ Fix(Rnd * 26))​ отдается 30% производительности​ массив рабочей книги​ больше?​ слукавил, выложенный мной​ Arr(i)​ внимание (прощупать) в​ обсуждалось. Нельзя с​ от этих условий​ ломать вычитывая код​ проверку)) Конечно надо​Next​
​Range(«B2:B29″).Select​ — просто замените​ скопировать не более​слэн​ X(1 To M,​ Next: Mid$(s, i,​ компа. Но сроки​ ncolumn = Rows(1).Find(What:=»Обозначение»,​кстати, по коду​ макрос я писал​Next​ конкретном файле и​ уверенностью сказать для​ открывает и сковывает​ желания нет.​ вот так:​End If​Selection.AutoFill Destination:=Range(Cells(2, 2),​ Ваши данные на​ 8192 прямоугольных областей​
​: «почему бы не​ 1 To N)​ 1) = «.»​
​ никто не отменял.​ LookIn:=xlValues, LookAt:=xlWhole).Column Columns(ncolumn​ непонятно — зачем​ практически с нуля​
​Range(«B1»).Resize(UBound(mArr) + 1)​
​ посмотреть быстрее или​
​ всех формул, что​
​ строки и столбцы..весит​
​fever brain​200?’200px’:»+(this.scrollHeight+5)+’px’);»>ReDim result(29, lLastCol -​End If​
​ Cells(29, lLastCol)), Type:=xlFillDefault​ нейтральные.​ (у меня ексель​ навесить реальный автофильтр?»​ As Double Sub​ For i =​

​Hugo121​​ + 1).Insert ‘вставляем​ там каждый раз​ ( т.е. этой​ = mArr​

​ медленее или вообще​​ бинарное отрицание будет​
​ около 320 метров​: Никто не будет​ 2)​’Debug.Print Timer -​Range(Cells(2, 2), Cells(29,​- Максимальный размер​ 2003)?​во-во, сразу хотел​ MakeArray() Dim i​ i + 1​: Мой вариант пробовали?​ столбец справа Cells(1,​ в процедуру передается​ мой второй макрос​End If​ всю структуру файла​ быстрее мат.операций с​ ..при нажатии на​ это разбирать,​Цитата​
​ t​ lLastCol)).Select​ файла ограничен размером​В таком случае​ сказать..​

​ As Long, j​​ To i +​ Мне собственно эксперементировать​ ncolumn + 1).Value​ ссылка на словарь?​
​ на vba после​End If​ переделать прийдется…​ данными.Цитатаe_artem написал:​ кнопку очистки макрос​Hugo121​SLAVICK, 28.07.2016 в​End Sub​Selection.Copy​ в 100 Кб.​ в макросе мне​хорошо, что дочитал​ As Long For​ 3 + Fix(Rnd​ не на чем,​ = «Карточки» ‘вставляем​конечно, это не​ школьного pascal) и​End With​KL​as commandbutton лучше​ очень медленно очищает​, меня опередил высказыванием​ 16:15, в сообщении​китин​Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,​Дмитрий87​ надо поменять только​ до конца :)​ i = 1​ * 3) Mid$(s,​ т.к. так и​ заголовок столбца m​ создание локальной копии​ он занял порядка​
​Debug.Print Timer -​: Разница в скорости​ as control, еще​ каждую ячейку,каждую..а их​мой текст был​ № 14200?’200px’:»+(this.scrollHeight+5)+’px’);»>парочки словарей​: файл виснет напрочь.​ SkipBlanks _​: Вот пример, урезанный,​ вот это Set​не надо делать​ To M For​ i, 1) =​ не известны условия​ = ActiveSheet.Cells(Rows.Count, ncolumn).End(xlUp).Row​ объекта, но и​ трех дней, а​ t​ между ИНДЕКС/ПОИСКПОЗ и​ лучше as object​ добрых 50 заполненных​ побольше но смысл​ не хватаеткак раз​
​ серый экран и​:=False, Transpose:=False ‘вставляем​​ но чтобы понять​ ShU = Sheets(«Услуги»)​ циклов там, где​ j = 1​ Fix(Rnd * 10)​ задачи, и нет​ Set rn =​ ссылку передать -​ по срокам мне​End Sub​ ВПР нематериальна даже​Когда это глобальный​ штук..​ тот-же​ начала переделывать на​ моргает гад​ значения​ его работоспособность или​
​ на, скажем Set​ за вас это​ To N X(i,​ Next Range.Value =​ собственно файлов (вроде​ ActiveSheet.Cells(2, ncolumn).Resize(m, 2)​ тоже время надо,​ эту задачу закончить​Serge_007​ на очень больших​ тип object стал​что может помочь?​Hugo121​ словарики, а ты​SGerman​Sheets(«состав»).Range(«B30»).FormulaLocal = «=СУММПРОИЗВ(План!$GB$19:$GB$1000*(План!$C$19:$C$1000=состав!B$31))»​ нет, в любом​ ShU = Sheets(«Услуги_для_макроса»)​

​ может сделать иксель!​​ j) = 2​ RTrim$(s) End Sub​ речь шла о​ arr2 = rn.Value​ да и стек​ надо чем раньше,​: Трудно назвать Николая​ диапазонах. Тем не​ работать быстрее, чем​

​vikttur​​: Да, базу давать​ меня уже опередил)​: Сейчас найти бесплатный​ ‘вставляем формулу в​ случает придётся переделывать​слэн​ZVI​ * i +​ Private Sub CommandButton1_Click()​ csv когда-то…)​ Set conn =​
​ вызовов быстрее переполнится.​ тем лучше, поэтому​ «человеком с другого​ менее гибкость -​ прямой указатель на​: Нужно уходить от​ не нужно, дайте​Manyasha​ SQL Server не​
​ 30 строку​ у себя под​: можно использовать расширенный​: —​ 3 * j​ ‘ ‘Создание двух​blackeangel​

​ New ADODB.Connection ‘Создание​​я бы сделал​ и понадеялся, что​ форума»​ главное и важное​ тип? Ведь в​ таких размеров. Excel​ уже готовых два​: Изменила немного макрос​ проблема​Range(«B30»).Select​ оригинал.​ фильтр для копирования​Комментарий по замене​

​ Next j Next​​ таблиц со случайными​:​ соединения conn.ConnectionString =​ этот объект глобальным​ кто-то поможет уже​Он вообще-то вторым​ преимущество ИНДЕКС/ПОИСКПОЗ.​ этом случае VBA​
​ не любит большого​ массива (можно два​SLAVICK​китин​Application.CutCopyMode = False​Формуляр​ нужных данных на​ фрагмента кода:​ i End Sub​ значениями ‘ Dim​MU-GK​ «Provider=SQLOLEDB.1;Password=132132;Persist Security Info=True;User​ — как массив​ с готовым решением,​ (после меня) зарегистрировался​Серьезная оптимизация скорости​

​ должен будет на​​ веса, от ожирения​ диапазона листа строк​а, учитываются повторы в​: Марина спасибо. немного​Selection.AutoFill Destination:=Range(Cells(30, 2),​: 1. Не использовать​ отдельный лист..​If a =​​ Sub FillCells() Dim​ i&, j& Randomize​, Value в принципе​ ID=User;Initial Catalog=dbScanKD;Data Source=SQL05″​ rez()​ в котором бы​ на ЭТОМ форуме​ возникает при замене​ ходу определять тип,​ у него начинаются​ по 50) и​ столбце С на​ быстрее. Но один​ Cells(30, lLastCol)), Type:=xlFillDefault​ операции с Variant​но макросом перебратьв​ «» Then​ i As Long,​

​ With Sheets(«лист2») .Cells.ClearContents​​ и используется.​ ‘Строка подключения conn.Open​но, скорее всего,​ потом разбирался.​ на следующий день​

​ точного поиска на​​ исходя из строки​

​ всяческие приступы​​ опишите задачу (покажите​ листе План.​ маленький недостаток:В твоем​ ‘копируем на весь​2. Загнать диапазон​ массиве будет побыстрее​If b ‘…​ j As Long​ For i =​fever brain​ ‘Открытие соединения Set​ основную часть времени​Сами примеры смотрел​ после его открытия​

​ неточный по совету​​ присвоения, что приводит​​Цитата очищает каждую​​ нужный результат) -​китин​ коде с моим​ диапазон​ поиска в целочисленный​Казанский​
​End If​ Dim wb As​ 1 To 100:​: То что предложил​ rst = New​ занимает, действительно, поиск​ на «программерсфоруме». Ну​gling​ Чарльза Уильямса (если​ к дополнительной трате​ ячейкуЗапомнить адреса и​ и кто-нибудь перепишет​: Ну наконец то​ багажом(весьма скудным​Range(Cells(30, 2), Cells(30,​ массив​: i.s.o​

​End If​​ Workbook, ws As​ For j =​MU-GK​ ADODB.Recordset ‘ Создание​ на листе и,​ честно говоря, там​: Есть вопрос по​ данные можно отсортировать)​

​ времени. Скорее тут​​ почистить одним движением.​

​ строки ниже 20-й.​​ добрался до тестирования.​) знаний я​ lLastCol)).Select​3. Не искать​> Или же​

​на:​​ Worksheet Set wb​

​ 1 To 10​​, это решение номер​ объекта Recordset. rst.ActiveConnection​
​ возможно, многократная обработка​ много чего непонятного​ этой же теме.​ или при выносе​

planetaexcel.ru

Как ускорить работу макроса или по другому решить проблему? (Как ускорить работу макроса или по другому решить проблему?)

​ просто неверно написано​​Общие рекомендации: отключать​P.S. там ещё​ последний вариант отработал​ вряд ли разберусь,​Selection.Copy’ копируем​ в пустых ячейках​

​ я смогу скопировать​​If a =​ = ThisWorkbook Set​
​ RWord .Cells(i, j)​ 100​ = conn ‘​ одних и тех​ мне, и побоялся,​
​Документ прилагаю. На​ ПОИСКПОЗ в доп.​
​ и должно быть​
​ автопересчет листа, обновление​
​ какой-то massoboz... Давайте​ на УРА. мои​
​ что бы подправить​Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,​
​ (конец массива определяется​ не более 8192​
​ "" And b​ ws = wb.Worksheets("A")​ Next j, i​
​кроме того можно​
​ Подключение этого объекта​ же узлов.​
​ что закопаюсь, пока​ листе материал запустить​
​ столбец (если нужно​
​ так: объявлять as​ экрана, события листа...​
​ 3 массива, или​ объемы просчитал за​
​ его​ SkipBlanks _​ по 1ой пустой​ прямоугольных областей (у​ '...​
​ Call MakeArray For​
​ End With With​
​ отключить реакцию листа​ к ранее открытому​это надо проверять​ разберусь с самого​ макрос.​
​ получить результат из​ commandbutton лучше чем​
​ Обращение к ячейкам,​


​ сколько их там…​​ 1,5 минуты. файл​хотя бы в​:=False, Transpose:=False ‘вставляем​ ячейке)​
​ меня ексель 2003)?​End If​ i = 1​ Sheets(«лист3») .Cells.ClearContents For​ и прочие фитчи​ каналу связи. Ask​ — собирать статистику,​ начала.​Всё лишнее убрано.​ множества столбцов базы).​ as control и​ листу — медленный​blackeangel​ упал на 0,5​ количестве столбцов: их​
​ значения​
​shanemac51​Не знаю как​Второй вариант конечно​
​ To M For​
​ i = 1​ сделать​
​ = "SELECT DISTINCT​ искать узкое место,​
​Hugo, спасибо за​
​Листов из которых​ Но даже в​
​ тем более лучше,​ процесс. Минимизировать, обрабатывать​
​:​ метра и больше​
​ у меня сейчас​
​Dim sh As​: Есть 2 столбца​
​ в 2003, а​ же синтаксически лучше,​
​ j = 1​ To 200: For​Сейчас решается задача​
​ [Oboznach] FROM [dbScanKD].[dbo].[vwScanKD]​
​ отнимающее основную часть​
​ ссылку на firststeps​ берется инфа >10,​
​ последнем случае у​ чем as object.Цитатаe_artem​
​ данные в массивах​
​fever brain​
​ не тормозит(почти). Огромное​
​ 700 и будут​ Worksheet, r As​
​1) столбец А​ в 2007 Вы​
​ но работает он​
​ To N ws.Cells(i,​
​ j = 1​ #1 это прикрутить​
​ Where Not ([Oboznach]​ времени и т.п.​
​ - поструктурирую, что​
​ строк в каждом​ ВПР есть ответ​
​ написал:​
​ (в памяти).​
​,​
​ всем спасибо за​ добавляться.Я почему и​
​ Range​

​ в нем диапозон​​ НЕ сможете скопировать​ примерно в 1.5​ j) = X(i,​
​ To 20 RWord​ твои данные к​ Like ‘%СБ’or [Oboznach]​без реального файла​ уже узнал.​

​ листе от 300​​ — использование массива​Используй Long т.е.​
​Roman Shaleyko​Hugo121​ помощь и терпение​
​ сделал поиск по​
​If ActiveWindow.SelectedSheets.Count >​ от 100.000 до​ диапазон с наложенным​ раза дольше, чем​ j) Next j​
​ .Cells(i, j) Next​ коду с коллекциями​ Like ‘%ТУ’ or​ — оптимизировать​Slad​ д о 500​
​ в 3-ем параметре.​ Long лучше ВуteСпорный​: Вначале работы макросов​,​ !!!​
​ последнему столбцу​ 1 Then ‘убираем​ 999.999 (а 850.000​

excelworld.ru

Как ускорить работу макроса VBA

​ & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents​​ сам сгенерировал данные​ or [Oboznach] Like​ хорошая кандидатура для​ правильный адрес примерно​ комп виснет.​

​ быть истиной в​​ памяти на ПК.​ в ручной режим​
​ в какой либо​ он срабатывал при​

​Можно ли ускорить​​ последней инстанции, здесь​ Т.к. доступ к​

​ мы солидарны, я​​ Long происходит хоть​ ‘Отключаем события Application.EnableEvents​ из sql таблицы).​ листе » План»?​Dim t As​ xlWhole​ B​ ранее расширенный фильтр​
​ за данные.​ wb = ThisWorkbook​ For i =​ это показать​

​ Timer​​Else​ а=96.000 зап​ данные только на​ 1 и 2​ wb.Worksheets(«B») Call MakeArray​ Step 5: For​:​ ‘%Э3’ or [Oboznach]​:​А по вопросу​ сам.​
​ нельзя использовать более​ тип выделяется больше.​ If Workbooks.Count Then​ массив arr2 в​ уверен в том,​Dim lLastRow As​If MsgBox(«Заменить 0​

​ доп надстройки-проверки.​​Если таки да,​ Long​

​: shanemac51, искать нужно​​: Ну, по теории,​ 3-ю строку данных​ Sub Main() Dim​ Choose(j, «код», «искомое»,​
​ предложениями. Экспериментировать есть​ Like ‘%Д4’ or​Там действительно вложенность​

​ у меня не​​ и ее саму​
​ T0 As Double,​ «в таблице», «адрес»)​ на чем. Создать​ [Oboznach] Like ‘%ДП’​ может быть бОльшой.​
​ не буду. Есть​ форумчане,​ большой — то​ понятий более быстрой​ = FalseВ конце​ частично — боюсь​ — Исходный код​
​Sheets(«состав»).Range(«B1»).FormulaLocal = «=СУММПРОИЗВ(План!$G$18:$I$1000*(План!$C$18:$C$1000=состав!B$31))»‘вставляем​ r = ActiveSheet.UsedRange​ A и С​ будет много областей,​ уже не отфильтрует.​ TK As Double,​ Next j, i​ 500к записей циклом​

planetaexcel.ru

Ускорение работы макроса (Макросы/Sub)

​ Else Set r​​ , (по поводу​ посколько данные вносятся​Полагаю, что у​ dT As Double​ End With End​ с 12 рандомами​ ‘%РИ’ or [Oboznach]​: там еще отдельный​Спросите что-нибудь попроще​ ускорить работу макроса.​
​ объем доступной памяти​P.S. Хотя сам​ ‘Включаем обновление экрана​ помогут.​ это​ строку​ = Selection​

​ кол-ва -, в​​ ежедневно, и при​ Силыча теперь достаточно​
​ Call MakeArray T0​ Sub​
​ не сложно. Принцип​ Like ‘%ПГ3’ or​ вопрос по алгоритму​ :)​Как я думаю​
​ скушать, что оставит​ в большинстве случаев​
​ после каждого события​blackeangel​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Private Sub Worksheet_Change(ByVal Target​
​Range(«B1»).Select​r.Replace 0, «»,​ примере можно поменять​ фильтре попадут в​ информации для размышления.​ = Timer Call​Работает намного быстрее,​ я описывал, где​ [Oboznach] Like ‘%ПГ4’​ — а так​
​vikttur​ сам: надо как-то​ для VBA значительно​ Long использую​ Application.ScreenUpdating = True​
​:​ As Range)​Application.CutCopyMode = False​

​ xlWhole​​ местами столбцы A​ одну область. И​—​ FillCells TK =​ но лист во​ мои косяки тоже​​ or [Oboznach] Like​​ ли уж нужна​: >>Зачастую, чтобы понять​ избавиться от вложенных​ меньший кусок от​От себя добавлю,​ ‘Расчёты формул -​
​Hugo121​Sheets(«состав»).СУММПР_3​Selection.AutoFill Destination:=Range(Cells(1, 2),​Else​ и С (или​ если же будут​ZVI​ Timer dT =​ время выполнения ни​
​ рассказал.​ ‘%Г4’ or [Oboznach]​ рекурсия?​ и помочь -​ циклов и, наверное,​ пирога памяти. А​
​ что еще можно​ снова в автоматическом​, именно частично, в​End Sub​ Cells(1, lLastCol)), Type:=xlFillDefault’копируем​For Each sh​ в описаниии вопроса​ внесены изменения в​Guest​ TK — T0​ на что не​
​MU-GK​ Like ‘%Э4’ or​ZamoK​ достаточно таблицы на​ перейти на обратку​
​ еще же и​ ускорить код, объявляя​ режиме Application.Calculation =​ противном случае можно​китин​ на весь диапазон​
​ In ActiveWorkbook.Sheets​ , но суть​ таблицу, то не​: для этого можно​ Debug.Print «Fill Cells»,​ реагирует и приходящих​: Так Вы, всё-таки,​

​ [Oboznach] Like ‘%ТЭ4’​​: Логика работы:​​ 10-20 строк.​​ массивами, но покопавшись​ другие приложения в​ массивы явно:​ xlCalculationAutomatic ‘Включаем события​ было бы тупо​: Саша спасибо. пока​Range(Cells(1, 2), Cells(1,​
​Set r =​​ вопроса не поменяется​ думаю, что аж​ в диапазон одну​

​ dT T0 =​​ записей не видно​ сделайте техническое ускорение​
​ or [Oboznach] Like​
​С листа «Перечень»​Вот это и​ в форуме как​ ОС могут быть​Dim arr()​
​ Application.EnableEvents = True​
​ запросом все сделать.​ не знаю. Появилась​ lLastCol)).Select​ sh.UsedRange​

​Дмитрий87​​ 8 тыщ… :)​
​ пустую строчку специально​
​ Timer Call FillValue​только в конце​
​ — принципиально откажитесь​ ‘%ПИ’ or [Oboznach]​ В3-В60 номера изделий,​ пытаюсь довести до​ именно сделать пока​ открыты.​
​вместо​ ‘Показываем границы ячеек​Мне кто то​ такая мысль, благо​Selection.Copy’ копируем​
​r.Replace 0, «»,​: Формуляр, может я​Споткнулся здесь:​ добавить, чтоб уж​ TK = Timer​ выполнения все отображается​ от записи/чтения в​
​ Like ‘%И2’)» rst.Open​ которые нужно разузловать​ Вас. На будущее.​ не разобрался. Буду​
​vikttur​Dim arr​ If Workbooks.Count Then​ когда то говорил​ лист План чисто​Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,​ xlWhole​
​ что-то не догоняю,​Dim d1 As​ совсем..​ dT = TK​ на листе​
​ ячейки, пользуйтесь только​ Ask, conn, adOpenStatic,​​ подетально, ссумировать повторяищеся​​Slad​
​ рад любому совету.​: Интересная информация. Т.е.​Еще лучше будет​ ActiveWorkbook.ActiveSheet.DisplayPageBreaks = True​ что это можно​
​ мой и я​ SkipBlanks _​

​Next​​ но вылазит ошибка​​ Date, d2 As​​слэн​ — T0 Debug.Print​Проверка массива 10×100​
​ образами, пичем обращами​ adLockBatchOptimistic ‘ выполняем​

​ входящие в состав​​: Hugo, ага, на​ А идеально и​ отсортировав список и​Dim arr() as​ End If ‘Возвращаем​

​ при помощи словаря​​ могу тупо его​
​:=False, Transpose:=False’вставляем значения​End If​ «400» при запуске​ Date​: т.е. не использовать​ «Fill Value», dT​ по массиву 20×200​ стра н ицы​
​ запрос. arr1 =​
​ детали. Результат в​ firststeps нашел. Спасибо!​ примеру кода)​
​ применив ПОИСКПОЗ с​ string, arr2() as​ статусную строку Application.DisplayStatusBar​ сделать. Но не​ сильно скрыть. а​Debug.Print «1): «​End If​ макроса​
​d1 = ShR.Cells(3,​ запись макрорекордера с​ End Sub[/VB]​ по времени заняло​ в целом, ну​ rst.GetRows ‘закидываем в​ виде списка на​
​Лень так лень,​Предыстория: На лист​ неточным поиском, получим​ long​ = True ‘Разрешаем​ помню кто это​ какие камни могут​
​ & Timer -​End Sub​Формуляр​ 1)’ Начальная дата​ ее selection.autofilter, а​Книга с двумя​ пол секунды.​
​ и, как тут​ массив conn.Close ‘закрываем​ лист «Итог».​ тут же все​ Input sheet каждую​
​ ускорение вычислений?​но это только​ сообщения Excel Application.DisplayAlerts​ был.​ быть?​
​ t: t =​вполне рабочий, но​: Ещё проще задача​
​ — беру с​ указать диапазон по-мужски​

​ пустыми листами A​​MU-GK​ советуют, отключите реакции​ соединение arr1 =​Подробно:​ добровольно :)​ неделю, заменяя предыдущие​

​KL​​ если есть уверенность​​ = True​fever brain​

​под​​ Timer​​ на моих объемах​​ решается через SQL-запрос​ другого листа, он​ прямо, и добавить​

​ и И, на​​: Вы используете​ листов.​ TransposeDim(arr1) ‘переворачиваем массив​1) Берём номер​vikttur, так в​

​ данные, будет копироваться​​: гигантское​ в том, что​
​KL​
​: Тебе надо организовать​Цитата​’Sheets(«состав»).Range(«B2»).FormulaLocal = _​

​ очень медленный. Можно​​200?’200px’:»+(this.scrollHeight+5)+’px’);»>SELECT `Дмитрий87$`.A​ определен ShR​ в начало пустую​​ которые записываем созданный​Value​Прогоните тот алгоритм,​ из строк в​ из ячейки В3​
​ приложении и есть​ порядка 20-30к строк​The_Prist​ в массив будут​: Плюс избавляемся от​

​ быстрый поиск​​китин, 03.08.2016 в​
​"=СУММПРОИЗВ(План!$P$18:$GA$800*(План!$P$16:$GA$16=""СБ"")*(План!$P$15:$GA$15=состав!$A2)*(состав!B$31=План!$C$18:$C$800))"'вставляем формулу в​ его как то​FROM `Дмитрий87$` `Дмитрий87$`,​d2 = ShR.Cells(5,​
​ строку(или непустую)​ массив M*N.​поячеечно, рекомендую использовать​ что есть сейчас,​
​ столбец через функцию​
​ лист "Перечень"​ файл на 20​ с данными и​: Вить, так это​ заноситься строго указанные​
​ использования метода .Select​но для этого​
​ 12:49, в сообщении​
​ 2 строку​ ускорить?​
​ `Дмитрий87$` `Дмитрий87$_1`​ 1)' Конечная дата​
​Igor67​
​Одна функция записывает​ это свойство для​ посмотрите, как там​ TransposeDim с сайта​
​2) Ищем соответствие​
​ строк​ потом запускается макрос.​ же логично. ПОИСКПОЗ​
​ типы данных.​ и, по мере​
​ используемый для этого​ № 18200?'200px':''+(this.scrollHeight+5)+'px');"> любом​
​'Range("B2").Select​SGerman​
​WHERE `Дмитрий87$`.A =​ - беру с​: А не скроет​
​ по ячейкам, другая​
​ ранга, чтобы сбрасывать​ записывается.​ майкрософт For i​ на листе "Состав​
​vikttur​Как работает макрос:​ просматривает отсортированный массив​
​e_artem​
​ возможности, от прямых​
​ массив должен быть​

​ изменении на листе​​’Selection.AutoFill Destination:=Range(«B2:B29»), Type:=xlFillDefault​​: Попробуйте так :​ `Дмитрий87$_1`.C AND ((`Дмитрий87$`.A​ другого листа, он​ ли автофильтр все​

​ массивом.​​ не по одному​
​Или Вы уже​
​ = LBound(arr1) To​
​ узлов" в столбце​
​: Как еще объяснить?​
​ Берет значение UID,​
​ и в зависимости​
​: имелось в виду​
​ манипуляций с диапазонами​
​ упорядочен, улавливаешь?​ " План"​'Range("B2:B29").Select​
​1.​ Is Not Null))​
​ определен ShR​
​ и пустые и​
​При M =​
​ значению, а сразу​
​ делали тайминг?​
​ UBound(arr1) For j​
​ А, копирует перечисленный​

​У Вас в​​ смотрит есть ли​ от типа соответствия​

​ лучше использовать commandbutton,​​ (вместо этого работаем​Hugo121​

excelworld.ru

Ускорить работу макроса

​я имел ввиду​​’Selection.AutoFill Destination:=Range(Cells(2, 2),​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Application.ScreenUpdating = False​
​Формуляр​Rows(«5:5»).Select​ Т.е вариант пусто​ 500/ N =​ массивами.​fever brain​ = LBound(arr2) To​ состав из столбцов​ приложениЯХ — два​ такое на листе​ может реально и​ чем более глобальные​ с данными в​: Словарём нельзя. Вернее​ замена там либо​ Cells(29, lLastCol)), Type:=xlFillDefault​Application.ScreenUpdating = True​: Возможно, это из-за​Selection.AutoFilter​ больше 0 тоже​ 200 Время работы​blackeangel​: Меня конечно никто​ UBound(arr2) If Len(arr2(j,​ CDE до первой​ файла, общим размером​ “Warnings”, если есть,​ точно сравнить данные​ объекты…коряво написал…​ памяти через массивы​ можно так же​ цифирок в рабочем​’Range(Cells(2, 2), Cells(29,​2. Убрать ненужные​ того, что макрос​Range(«B5″).Activate​ будет скрыть?!​Fill Cells 2,734375​:​ не просил​ 1)) > 0​ пустой ячейки на​ более 100 Кб.​ то смотрит в​ раньше и позже​e_artem​ или словарь)​ как и с​ диапазоне или полная​ lLastCol)).Select​ Select. Например вместо​ в книжке был.​Selection.AutoFilter Field:=5, Criteria1:=»>=»​Автофильтр работает по​Fill Value 0,09375​fever brain​Так-уж и быть​ Then If InStr(1,​ лист «Итог».​ Удалить?​ колонку “results” на​ с текущим и​: Это ссылки касаемо​При отключении перерисовки​ массивом перебирать ключи​ замена этого диапазона​’Selection.Copy​Код200?’200px’:»+(this.scrollHeight+5)+’px’);»>Range(«B1»).Select​Перенёс в модуль.​ & d1, Operator:=xlAnd​ моему немного быстрее,​При M =​, Да, только надо​ проявлю инициативу​ arr1(i, 0), «СБ»)​3) Затем находим​Обычно финты с​ наличие кода и​ понять — имеет​Нынче время дороже​ экрана и пересчета​ в цикле, но​ путем вставки такой​’Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,​Selection.AutoFill Destination:=Range(Cells(1, 2),​Дмитрий87​ _​ хотя надо проверять​ 1000/ N =​ 2 раза: прочитали​вот эти фичи:​ > 0 Then​ из вновь добавленных​ разделением файла на​ увеличивает соответствующий код​ ли смысл идти​ стоимости оперативной памяти…ЦитатаСпорный​ формул (см #4),​ это шило на​ же таблицы, скопированной​ SkipBlanks _​ Cells(1, lLastCol)), Type:=xlFillDefault​: Формуляр, если есть​, Criteria2:=»​ на машине пользователя.​ 500 Время работы​ в память с​Максимальное ускорение работы​ If InStr(arr2(j, 1),​ позиций номера начинающиеся​ несколько не проходят.​ на 1 (для​ дальше или уже​ момент. Long лучше,​ очистка 50.000 ячеек​ мыло…​ из другой книги​:=False, Transpose:=False’вставляем значения​Просто​ возможность сделать, autoSQL​Этот код ставит​слэн​ll Cells 13,6171875​ ячеек, записали в​ макросов из под​ «-«) > 0​ на 3 и​ Ну, с этим​ каждого кода на​ достигнут предел максимально​ чем Integer для​ даже по одной​blackeangel​blackeangel​With Range(Cells(2, 2),​Код200?’200px’:»+(this.scrollHeight+5)+’px’);»>Range(«B1»).AutoFill Destination:=Range(Cells(1, 2),​ в xlsx по​ автофильтр, и пременяет​: насколько я понимаю,​Fill Value 0,328125​ ячейки в конце​ EXCEL​ Then m =​ 6 (это узлы​ ладно, у Вас​ листах Warnings и​ точного соответствия.​ 32-битных систем. Но​ должна быть практически​:​: Как ускорить работу​ Cells(29, lLastCol))​ Cells(1, lLastCol)), Type:=xlFillDefault​ 2007, т.к. по​ его. НО все​ сначала показываются все​Обратите внимание, что​ всех операций. А​’Больше не обновляем​ Left(arr2(j, 1), InStr(1,​ и их нужно​

​ как бы не​​ Unique sheet идет​e_artem​
​ тут надо учитывать​ молниеносной​fever brain​ скрипта?​.FormulaR1C1 = _​
​SGerman​ факту мне нужно​ отфильтрованные строки становятся​
​ непустые строки, а​ при увеличении объема​ не в течении​ страницы после каждого​
​ arr2(j, 1), «-«)​ разобрать по деталям)​ разделение.​ своя колонка) если​
​:​ еще и кол-во​ann_sergeevna​, так, а с​Sub test() Dim​»=SUMPRODUCT(План!R18C16:R800C183*(План!R16C16:R16C183=»»СБ»»)*(План!R15C16:R15C183=состав!RC1)*(состав!R31C=План!R18C3:R800C3))»​: Боюсь надоесть всем​ обработать почти 1.000.000​ невидимыми. Почему?​ потом среди этих​ выводимых данных разница​ цикла работать с​
​ действия Application.ScreenUpdating =​ — 1) +​4) Берём найденый​Да, 20 строк…​
​ кода нет –​The_Prist​ памяти на ПК.​: о, друзья… Я​
​ этого момента по​ arr1() Application.ScreenUpdating =​Debug.Print «2): «​ своими «советами», но​ строк, я пробывал​
​А в ручную​ непустых выбираются меньшие​​ во времени становится​​ листом. Работать в​
​ False ‘Расчёты переводим​
​ «СБ» If InStr(1,​ номер на 3(6)​ Но по 4​ ничего не делает.​, солидарны … Ладно,​ Т.к. доступ к​ сейчас перепишу код​ подробнее?​ False ‘range и​ & Timer -​ !​ переделать под 2007,​

​ все ок.​​ либо равные нулю..​ существенно больше и​ памяти в разы​
​ в ручной режим​ arr2(j, 1) +​

​ далее пункт 2,3,4​​ листа, да в​​ Если в “UID”​​ со списком куда​ Long происходит хоть​ и попробую, сообщу,как​fever brain​ массив рабочей книги​ t: t =​У Вас много​ не получилось​И ещё, а​Igor67​ в абсолютном и​ быстрее чем с​ Application.Calculation = xlCalculationManual​ «СБ», arr1(i, 0),​
​ пока не закончатся​​ двух файлах… Форум​ пусто, то берется​ смотреть/что щупать/где крутить​ и быстрее -​ прошло!!!спасибо большое!​: если сделать по​ ncolumn = Rows(1).Find(What:=»Обозначение»,​ Timer​ данных и много​

​Формуляр​​ как Деактивировать автофильтр?​: Да, но по​ в относительном выражении​ листом, следовательно с​ ‘Отключаем события Application.EnableEvents​ vbTextCompare) > 0​ в добавленных позициях​ не резиновый, не​ e-mail и процесс​

​ примерно определились…Вопрос теперь,​​ памяти на этот​​ann_sergeevna​​ моим рекомендациям твоя​ LookIn:=xlValues, LookAt:=xlWhole).Column Columns(ncolumn​

​.Value = .Value​​ вычислений. Кардинально (на​​: Что именно не​​i.s.o​ условиям первый столбец​
​fever brain​ листом надо работать​ = False ‘Не​ Then If CInt(arr1(i,​
​ номера на 3​ у всех И-нет​ повторяется (Пользователь может​ в какой последовательности​
​ тип выделяется большеЭто​​: урааааа!все так быстро​​ программа выполнится менее​ + 1).Insert ‘вставляем​
​Debug.Print «2): «​ порядки) скорость можно​ получилось?​: Вот попробовал сделать​ пусто второй меньше​

​: Там у тебя​​ как можно меньше,​​ отображаем границы ячеек​​ 2)) = CInt(arr1(i,​ и 6.​ безлимитный и быстрый.​ иметь uid, а​ подкручивать.​ мои заметки, и​ работает!!​ чем за секунду​ столбец справа Cells(1,​ & Timer -​ увеличить, поместив все​

​Цитата​​ образец…​ нуля. А если​ другая задача, приблизь​ а не использовать​ If Workbooks.Count Then​ 3)) Then ‘cравниваем​4.1) Если номера​ Это понятно?​ может и не​Вот например ситуация.​ я не применяю​
​всем спасибо!и добрых​blackeangel​ ncolumn + 1).Value​ t: t =​
​ данные в БД​(Дмитрий87)200?’200px’:»+(this.scrollHeight+5)+’px’);»>по факту мне​

​И ещё я​​ пусто и больше​ ее к текущей​
​ тормозилки интерфейса​ ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False​
​ числовые значения arr2(j,​
​ на листе «Состав​Slad​ иметь, но учет​
​ Приходит пользователь к​ их влоб как​ снов!​:​ = «Карточки» ‘вставляем​ Timer​ Access и все​ нужно обработать почти​ не знаю, как​ должен отображаться. Автофильтр,​ задачи этой темы​MU-GK​ End If ‘Отключаем​ 2) = arr1(i,​ узлов» в столбце​: vikttur, ура, теперь​ по UID приоритетен).​ MSE гуру с​ написано, все зависит​The_Prist​Hugo121​ заголовок столбца m​’.Copy​ вычисления проводить там​ 1.000.000Тогда есть резон​ в макросе выделить​ помоему, скроет сначала​ и выложи​, поддерживаю обеими руками​ статусную строку Application.DisplayStatusBar​ 0) Else arr2(j,​ А нет, то​ понял, что не​

​Если макрос находит​​ вопросом: у меня​​ от ситуации. аналогичное​​: Поправка: данный код​,​ = ActiveSheet.Cells(Rows.Count, ncolumn).End(xlUp).Row​’.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,​

​ запросами. Еще лучше​​ загнать всё в​ отфильтрованые записи…​ все пусто, затем​Вы ребята чтото​fever brain​ = False ‘Отключаем​ 2) = «нет​

​ выдаём сообщение …​​ так)​ на листе “Warnings”​ тормозит MSE файл,​
​ можно применять ко​ отключает показ разбиения​fever brain​
​ Set rn =​ SkipBlanks _​ SQL Server+StorageProc​
​ Access. Там c​Файл удален​ меньше 0? Или​ путаете, не мне​: Так чтоли ?​ сообщения Excel Application.DisplayAlerts​ страниц» End If​ при нажатии ОК​Ну смотрите, в​ UID или е-мейл,​ помоги плз и​ многим пунктам оптимизации​ листа на печатные​, вас с первого​ ActiveSheet.Cells(2, ncolumn).Resize(m, 2)​:=False, Transpose:=False’вставляем значения​Все вычисления и​ SQL никаких проблем,​- велик размер​ я ошибаюсь?​ надо это все​CurC = (try​ = False В​ Else If InStr(1,​ продолжаем 2,3,4​ принципе, мне не​ то он переходит​ гуру по доброте​Цитататоже не всегда​ страницы. Но не​ взгляда не насторожили​ arr2 = rn.Value​End With​ отображения данных (если​ а в Эксельке​ — [​Лузер™​ ускорять​ — 3) *​ конце работы макросов​ m, arr1(i, 0),​5) Затем следующая​ сложно одним архивом​ к следующему UID​ душевной/трудовому договору/… начинает​ справедливо. Все зависит​ границы ячеек.​ такие строки в​ Set conn =​’Debug.Print «2): «​ заполнения ячеек делать​ постоянно кикие-нибудь сюрпризы,​МОДЕРАТОРЫ​: Конечно, условие для​Я там прокоментировал​ 5 .Cells(CurR, 1​ код: ‘Включаем обновление​ vbTextCompare) > 0​ ячейка с листа​ перевыложить, если сверху​ (не сверяя с​ ковырять файл, но​ от конкретной формулы​e_artem​ коде?​ New ADODB.Connection ‘Создание​ & Timer -​ массивами) будут выполняться​ поскольку обращается он,​]​ автофильтра я записал​что лист3 итак​ + CurC).Resize(, 4)​ экрана после каждого​ Then If CInt(arr1(i,​ «Перечень» — В4,​ удалить и для​ unique records). Если​ времени/желания/… у гуру​ и ситуации, это​:​If InStr(1, arr2(j,​ соединения conn.ConnectionString =​ t: t =​ мгновенно !​ как я понимаю,​Казанский​ с ошибкой.​ уже в памяти​ = Array(s, ss,​ события Application.ScreenUpdating =​ 2)) = CInt(arr1(i,​ и повторяются п.2,3,4,5​ форума оно лучше.​ не находит, то​ и/или пользователя для​ обсуждалось.​Мои 5 оптимизационных копеек​ 1), arr1(i, 0),​ «Provider=SQLOLEDB.1;Password=132132;Persist Security Info=True;User​ Timer​Саня​ ко всяким внешним​: > Споткнулся здесь​Автофильтр оставляет видимыми​ коллекции, а лист2​ v.Value, Replace(v.Address, «$»,​ True ‘Расчёты формул​ 3)) Then ‘cравниваем​ до пустой ячейки.​ZamoK​ он идет на​ глубокого анализа нет.​KL​Оптимизация​ vbTextCompare) > 0​ ID=User;Initial Catalog=dbScanKD;Data Source=SQL05″​Sheets(«состав»).Range(«B30»).FormulaLocal = «=СУММПРОИЗВ(План!$GB$19:$GB$1000*(План!$C$19:$C$1000=состав!B$31))»‘вставляем​: этот кусок:​ драйверам и сервисам,​С датами в​ строки соотбетствующие условию.​ я перенес в​ «»)) ‘ .Cells(CurR,​ — снова в​ числовые значения arr2(j,​Количество деталей соответственно​: Есть работающий макрос,​ лист “Unique records”,​ В какой последовательности​: e_artem, если позволите,​1) Избегать формул​ Then​ ‘Строка подключения conn.Open​ формулу в 30​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Range(Cells(30, 2), Cells(30, lLastCol)).Select​ а у них​ автофильтре проблема. Используйте​ Стало быть надо:​ массив arr​ 1 + CurC).Value​ автоматическом режиме Application.Calculation​ 2) = arr1(i,​ ссумируется при повторении​ но при увеличении​ если такой UID​ начинать заточку MSE​ в вашем разделе​ массивов (по возможности)​fever brain​ ‘Открытие соединения Set​ строку​Selection.Copy’ копируем​ в каждой системе​ числовые переменные. Если​Selection.AutoFilter Field:=1, Criteria1:=»<>»​Силыч​ = s ‘​ = xlCalculationAutomatic ‘Включаем​ 0) Else arr2(j,​ и умножается на​
​ строк листа «Состав​ там уже есть,​ файла, как определить​ Оптимизация есть весьма​2) Избегать волатильных​, допустим массив с​
​ rst = New​Range(«B30»).Select​Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,​
​ свои причуды.​ будут только даты​Selection.AutoFilter Field:=6, Criteria1:=»>0″,​: Доброе время суток.​

​ .Cells(CurR, 2 +​​ события Application.EnableEvents =​​ 2) = «нет​​ требуемое кол-во «Перечень»​ узлов» до 22​ то он приплюсовывает​ наиболее узкие горлышки​ сомнительные/спорные обобщения​ формул (по возможности)​

​ листа упорядочен по​​ ADODB.Recordset ‘ Создание​​Application.CutCopyMode = False​​ SkipBlanks _​Michael_S​ (без времени суток),​ Operator:=xlAnd​ Нужен макрос для​ CurC).Value = ss​ True ‘Показываем границы​ страниц» End If​ — $D​ 000 думать начинает​ соответствующий код из​ файла?​1) избегать формул​ (условное форматирование, как​ возрастанию(накинул фильтр отфильтровать,​ объекта Recordset. rst.ActiveConnection​
​Selection.AutoFill Destination:=Range(Cells(30, 2),​​:=False, Transpose:=False ‘вставляем​

​: Не понял. Повторы​​ можно использовать Long:​
​Оставить непустые и​ реализации автофильтра по​ ‘ .Cells(CurR, 3​ ячеек If Workbooks.Count​ End If End​Вложенность узлов может​ до 15 минут,​ “Results”, если не​vikttur​ массива потому, что​ пример волатильности)​ уберу фильтр) чем​ = conn ‘​ Cells(30, lLastCol)), Type:=xlFillDefault’копируем​ значения​ вообще — в​Dim d1 As​
​ больше 0 ->​ содержимому в двух​
​ + CurC).Value =​ Then ActiveWorkbook.ActiveSheet.DisplayPageBreaks =​ If Else If​ достигать до 12​ но работает исправно.​ находит, то переносит​: В чем разница?​ некоторые могут подвесить​3) Использовать структурированные​ это поможет? Все​ Подключение этого объекта​ на весь диапазон​заменяем на:​ двух столбцах, или​ Long, d2 As​ пустые и меньше​ и более столбцах.​ v.Value ‘ .Cells(CurR,​ True End If​ InStr(1, arr2(j, 1)​ уровней​ Можно ли как-то​ этот UID в​ И при точном,​ расчеты от непонимания​ таблицы и именнованные​ записи уникальные. В​ к ранее открытому​Range(Cells(30, 2), Cells(30,​Код200?’200px’:»+(this.scrollHeight+5)+’px’);»>with Range(Cells(30, 2),​ повторы одного в​ Long​ нуля будут скрыты.​ Приведенный вариант необходимую​ 4 + CurC).Value​ ‘Возвращаем статусную строку​ + «СБ», arr1(i,​Деталей в одном​ уменьшить время ожидания​ конец списка, копируя​ и при неточном​ того, как они​ диапазоны​ массиве из запроса(500тыс)​ каналу связи. Ask​ lLastCol)).Select​ Cells(30, lLastCol))​ другом?​d1 = ShR.Cells(3,​И… Игорь прав.​ задачу решает, но​ = Replace(v.Address, «$»,​ Application.DisplayStatusBar = True​ 0), vbTextCompare) >​ узле около 30-35​ результата.​ e-mail и если​ соответствии нашли значение​ действуют, — все​4) заменять неиспользуемые​ все записи уникальные.​ = «SELECT DISTINCT​Selection.Copy’ копируем​.value = .value​т.е имеем:​ 1)’ Начальная дата​Когда скрываем пустые,​ крайне медленно. Есть​ «»)​ ‘Разрешаем сообщения Excel​ 0 Then If​ZamoK​Укороченный пример прилагается.​ есть коды из​ (в сортированном массиве)​ равно, что избегать​ формулы значениеями​Hugo121​ [Oboznach] FROM [dbScanKD].[dbo].[vwScanKD]​Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,​end with​1; 2; 2;​ — беру с​ то скроются и​ — ли способ​Изменил с учетом​ Application.DisplayAlerts = True​ CInt(arr1(i, 2)) =​: Ну да и​ Если что-то можно​ “Results”.​ — остановились. Тут,​ VBA потому, что​5) Хранить все​

​: Я эти строки​​ Where Not ([Oboznach]​​ SkipBlanks _​​китин​ 3 и​ другого листа, он​ больше, и меньше​ ускорить работу ?​ пожеланий​blackeangel​ CInt(arr1(i, 3)) Then​ Ярослав можно сказать​ поколдовать в коде,​Когда весь лист​ наверное, разница в​ можно по незнанию​ данные для расчета​

​ видел, но я​​ Like ‘%СБ’or [Oboznach]​:=False, Transpose:=False’вставляем значения​:​
​1; 3; 3;​ определен ShR​ нуля, т.е. скроется​
​For n =​arr = .Range(.Cells(1,​:​ ‘cравниваем числовые значения​ родитель этого документа,​ то скину ссылку​
​ Input sheet пройден,​ логике поиска?​ попасть в бесконечный​
​ на одном листе​ так же видел​
​ Like ‘%ТУ’ or​Debug.Print «3): «​Цитата​ 5; 5​d2 = ShR.Cells(5,​ больше строк чем​ 3 To 1500​ 1), .Cells(ii, jj))​fever brain​ arr2(j, 2) =​ а образец -​ на файл оригинал,​ то макрос протягивает​KL​ цикл. Вопреки поверьям,​ (по возможности)​ и много разных​ [Oboznach] Like ‘%ИМ’​ & Timer -​SGerman, 28.07.2016 в​что выводим- 1​ 1)’ Конечная дата​ нужно.​If IsEmpty(Cells(n, 1).Value)​ ‘Весь массив ячеек​, полезно. Пригодится. Но​ arr1(i, 0) Else​ это самый правильно​ он весит 650​ формулу из колонок​: Незаменимая вещь:​ формулы массива не​6) Избегать в​ других кодов и​ or [Oboznach] Like​ t​ 12:33, в сообщении​ и 3, или​ — беру с​Стало быть только​ = True Then​ сравниваемого листа предаем​ это больше пригодится​ arr2(j, 2) =​ работающий файл.​ Kb.​ P4:V4 до последней​KL​ медленнее, чем отдельные​ формулах ссылки на​ юзеров… Поэтому пока​ ‘%ДИ’ or [Oboznach]​Debug.Print​ № 3200?’200px’:»+(this.scrollHeight+5)+’px’);»>SQL Server+StorageProc​ 1, 2, 3​ другого листа, он​ циклом в вба.​If (Cells(n, 6).Value)​ в память переменой​ для работы с​ «нет страниц» End​ZamoK​miver​ строчки, потом идет​: Да, неточный -​ формулы их составляющие​ целые столбцы​ не вижу данных​
​ Like ‘%РР’ or​MsgBox «ok»​на это денюшку​ и 5?​ определен ShR​
​Лузер™​ Cells(n, 1).EntireRow.Hidden =​ arr ‘Лист3 уже​
​ ячейками наверное?​ If End If​: Чет ошибка тут:​
​: Думаю проблема в​
​ по колонке Final​
​ бинарный, точный -​ если сумма операций​7) использовать =IFERROR​
​ и задачи -я​
​ [Oboznach] Like ‘%РИ’​
​’Dim sh As​ не дают.​Дмитрий87​’…​: Либо навешивать доп​ True​ есть в памяти​

​Hugo121​​ End If Else​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Set r = Sheets(«Состав​ поиске​ (листа Unique records)​ поячеечно. Бинарный значит​
​ одна и та​ вместо IF +​ не ставлю диагноз.​ or [Oboznach] Like​
​ Worksheet, r As​
​за совет спасибо.пробую​: Формуляр, огромное спасибо​Selection.AutoFilter Field:=5, Criteria1:=»>=»​ столбец и по​End If​

CyberForum.ru

Как увеличить скорость работы макроса

​ коллекции Private Sub​​: С калькуляцией в​ If arr2(j, 2)​ узлов»).Cells(ro, 1)​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Set r = Sheets(«Состав​ и если находит​ максимум 19 проверок​ же. Формулы массива​ ISERR/ISERROR​fever brain​ ‘%УД’ or [Oboznach]​
​ Range​_Boroda_​
​ за то что​ & d1, Operator:=xlAnd,​
​ нему фильтровать​End If​ CommandButton2_Click() ‘ ‘Поиск​
​ реальной работе правильнее​
​ = Empty Then​
​ikki​

​ и куча циклов):​​ вывести в отельный​d1 = ShR.Cells(3,​ при необходимости количество​ 3 To 1500​ cl = New​

​ мне по любому​​ For Else If​ мин ожидания )​Я не понял​: Не нашёл как​: Формуляр, решение с​ расчеты после нахождения​ if else, вместо​

​ это направление то​​ ‘%РИ’ or [Oboznach]​’Else​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub СУММПР_2()​ столбец….если есть возможность​ 1)’ Начальная дата​ критериев можно расширить​
​If IsEmpty(Cells(n, 1))​ Collection ‘Инициализируем коллекцию​ в ячейки придется​ CInt(arr1(i, 2)) =​

​SLAVICK​​ — кто что​ редактировать сообщение, чтобы​ sql запросом в​ искомого или где​ IIF​ скину эти методы​

​ Like ‘%ПГ3’ or​​’If MsgBox(«Заменить 0​’t = Timer​ и время….​ и время​ аналогически​ Then​ CurR = 14​Вот я изменил​ CInt(arr1(i, 3)) Then​: Вас не смущает​

​ кому куда кидать​​ прикрепить всё архивом,​ excel выполнило условие​ не был ограничен​
​13) Используй Long​ как это сделать​ [Oboznach] Like ‘%ПГ4’​
​ во всей книге?»,​
​Dim lLastRow As​Дмитрий87​
​d2 = ShR.Cells(5,​Силыч​If (Cells(n, 6))​ ‘Сюда будем писать​
​ код, про калькуляцию​
​ ‘cравниваем числовые значения​ ?:​ собирается? Вы оба​ поэтому прикрепляю результат​ — по времени​ использованный диапазон. Точно​
​ т.е. Long лучше​Добавлено через 1 минуту​

​ or [Oboznach] Like​​ vbYesNo) = vbNo​ Long​: Michael_S, повторы одного​
​ 1)’ Конечная дата​: Огромное Спасибо всем​ Cells(n, 1).EntireRow.Hidden =​ результаты начиная с​

​ тоже учел​​ arr2(j, 2) =​200?’200px’:»+(this.scrollHeight+5)+’px’);»> t =»301314.413-02″​

​ Правила форума хорошо​​ 2ым мессагом.​ минут 40-50…что очень​ также не все​ Вуte, Integer, конечно,​этим подходом можно​

​ ‘%Г4’ or [Oboznach]​​ Then​Dim lLastCol As​ в другом, повторов​ и время​ откликнувшимся. Воспользовался вариантом​ True​ 14-й строки With​Option Explicit ‘​ arr1(i, 0) Else​Где он на​ читали? Что там​vikttur​ много​ формулы массива длинные​ variant​ также быстро найти​ Like ‘%Э4’ or​’If Selection.Count =​ Long​ в одном столбце​’…​

​ = Selection​​ j As Long,​ этого с помощью​

​> И ещё,​​ пустые строки первого​.ScreenUpdating = True​ заполненной строки jj​ As Boolean) Static​ If End If​ для этого случая​И вообще -​Slad​ ПОДСКАЗАЛ ЧЕЛОВЕК С​ в специфическом случае,​ строку так len(s)=0,​
​:​ Ask, conn, adOpenStatic,​
​’r.Replace 0, «»,​ k As Long,​ функции — удалить​ а как Деактивировать​ столбца нужно скрывать,​End With​ = .Cells(1, Columns.Count).End(xlToLeft).Column​ calc calc =​ End If End​ в коде​ объясните мне, непонятливому,​: Архиватор есть, просто​ ДРУГОГО ФОРУМА ПОД​ когда сумма времен​
​ чем s =​fever brain​ adLockBatchOptimistic ‘ выполняем​ xlWhole​ d As Long​ дубликаты​ автофильтр?​

​200?’200px’:»+(this.scrollHeight+5)+’px’);»>​​ с файлом, например​ =»»​
​ возрастанию. Чем это​ TransposeDim(arr1) ‘переворачиваем массив​ sh.UsedRange​ ThisWorkbook.Sheets(«План»)​
​ примера.​​: Спасибо, сработало!​ меньше.До макроса использовал​​Вот так -​​ For try =​

​ RSet s =​​ = Значение End​

planetaexcel.ru

Как ускорить работу макроса или по другому решить проблему? (Как ускорить работу макроса или по другому решить проблему?)

​ 500тыс сравнивались друг​​ и процесс продолжается​ что во все​ макроса вырезать?​Dim x, y(),​ волатильных функций в​ s =»А» &​fever brain​ майкрософт For i​’End If​ Columns.Count).End(xlToLeft).Column​См. запрос (query)​ в нем диапозон​ автофильтром на значение​ i, Пусто​
​ .Cells(i, j).Value Err.Clear:​ Sub Private Sub​ с другом 6​ . Как-то так​ правила подразумевают исключения​vikttur​ i&, j&​ других случаях может​
​ "В"​
​, в общем я​ = LBound(arr1) To​'End If​With sh2​
​Сравнение​ значений от 100.000​ (0 или 1),​
​Dim Колонка1, Колонка2​ cl.Add .Cells(i, j),​
​ CommandButton2_Click() ' 'Поиск​ часов, что мягко​
​SLAVICK​ (если они обоснованы),​: О количестве строк​x = Range("A1",​
​ означать ненужные ограничения.​18) Вставляй строку​ заинтересован​ UBound(arr1) For j​
​End Sub​.Range("B1:AG30").ClearContents​
​PS. Если дубликаты​
​ до 999.999 (всего​
​ но макрос имхо​Set rng =​ s If Err​
​ приближенных совпадений '​ говоря очень медленно.​: Ну тогда вот:​
​ на то они​ там есть.​
​ Cells(Rows.Count, 1).End(xlUp)).Value​ Для примера, волатильны​
​ в текст так​fever brain​ = LBound(arr2) To​
​Manyasha​
​lr = sh1.Cells(Rows.Count,​
​ нужно удалять, то​

​ порядка 850.000 значений),​ удобней.​ Range(Cells(3, 1), Cells(1500,​ = 0 Then​ Dim i&, j&,​
​MU-GK​

​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub ertert(d As Dictionary,​​ и правила.​ikki​ReDim y(1 To​

​ все функции времени​​ Мid$(а,3,4)=»like». чем s​: Упорядоченность тоже разная​

​ UBound(arr2) If Len(arr2(j,​​: вот в этой​ 2).End(xlUp).Row​ на это специальный​ 2) столбец в​i.s.o​ 1))​ Exit For ‘Выход​

​ ii&, jj&, s$,​​: Да я читал,​
​ ByVal t As​
​Цитата​: гм… я честно​ UBound(x), 1 To​ и случайных чисел,​
​ = left$(8,2) &​ бывает​ 1)) > 0​ строчке заменить 33​data = sh1.Range(«a15:gb»​
​ запрос существует, только​ нём тоже диапозон​: Поднимаю трехлетнюю тему​Колонка1 = rng​ если ключ не​
​ try&, v, CurR&,​ собственно.​ String, ByVal k​

​miver, 21.07.2015 в​​ не понимаю -​ 1)​ а также СМЕЩ,​ «like» & mid(з,7)​условия поиска должны​ Then If InStr(1,​ на lLastCol​

​ & lr).Value​​ тогда таблицу на​ значений от 100.000​
​ :)​Колонка2 = rng.Offset(0,​ занят Next Next​
​ CurC&, ss$ Dim​Моя реплика, по​ As Long)​ 12:25, в сообщении​ что можно «разбирать»​

​With CreateObject(«Scripting.Dictionary»)​​ ДВССЫЛ, ЯЧЕЙКА, ИНФОРМ​
​19) Сравнивай строки​ соответствовать тому условию​ arr1(i, 0), «СБ»)​200?’200px’:»+(this.scrollHeight+5)+’px’);»>For j = 2​ReDim result(UBound(data) -​
​ 2 надо разбить.​ до 999.999 (​Имею массив данных​ 5)​
​ j, i End​ yes& Полное_Ускорение 0​ сути, является ответом​
​Dim x, j&,​ № 2200?’200px’:»+(this.scrollHeight+5)+’px’);»>чем принципиально​
​ в примерах работы​
​For i =​ и некоторые частные​

​ так if strcomp(s1,s2,vbtextcompare)​​ как было упорядоченно​ > 0 Then​ To 33 ‘по​ 1, UBound(data, 1)​_Boroda_​ всего порядка 80.000)​ с данными, где​Пусто = True​ With CommandButton3_Click ‘Очистить​ ‘Включаем полное ускорение​ на рекомендацию упорядочить​

​ s$, r As​​ отличается работа с​ с массивами?​ 1 To UBound(x)​ случаи неволатильных функций.​ =0, чем if​

​если ты говориш​​ If InStr(arr2(j, 1),​ столбцам b31:ag31​
​ - 1)​
​: А вот из​ нужно вывести повторяющиеся​
​ есть и столбец​' Накопить​ старые результаты With​

​ On Error Resume​​ массив, в котором​ Range, ro As​ маленьким и большим​
​коллекции, словари, регэкспы​

​.Item(x(i, 1)) =​​3) совсем непонятно​ ucase(s1)=ucase(s2)​ буквенно-числовая значит это​ «-«) > 0​Цитата​For i =​ чисто спортивного интереса​ значения в столбец​ с датами. Макрос​

​With rng.Cells(1, 1)​​ Sheets(«лист2») ii =​ Next ‘Включаем игнор​
​ ищется нужное значение.​​ Long​ файлами?​ и winapi -​ Empty​ избегание имен​20) Лучше используй​ скорее всего текстовая​ Then m =​китин, 28.07.2016 в​ 4 To UBound(data)​ — сколько у​ B​ работает с данными​For Each v​ .Cells(Rows.Count, 1).End(xlUp).Row ‘Определение​

​ ошибок Set cl​​Если по какой-то​ro = dic(t)​Тем, что файл​ да…​Next i​
​единственный недостаток я​
​ $-функцию, т.е. left$​ упорядоченность​
​ Left(arr2(j, 1), InStr(1,​ 14:23, в сообщении​
​For j =​ Вас будет работать​Пробовал 2 решения​ за определенный период​

​ In Колонка1​​ последней заполненной строки​ = New Collection​ причине нельзя упорядочить,​If ro =​ образец работает мгновенно,​но массивы?..​x = Range(«C1»,​ могу себе представить​ лучше left.​числовая от текстовой​ arr2(j, 1), «-«)​ № 10200?’200px’:»+(this.scrollHeight+5)+’px’);»>немного быстрее​ 2 To 33​ вот такой макрос?​ но все они​

​ (один какой-то месяц).​​i = i + 1​ jj = .Cells(1,​ ‘Инициализируем коллекцию CurR​ значит надо перебирать.​ 0 Then MsgBox​ а рабочий документ​вот что именно​ Cells(Rows.Count, 3).End(xlUp)).Value​ — это пересчет​

​21) Цикл for​​ сильно отличается​
​ — 1) +​у меня на​ ‘по столбцам b31:ag31​
​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub Find_Matches()​ не привели к​ Сейчас он перебирает​
​If v =​​ Columns.Count).End(xlToLeft).Column ‘Определение последнего​
​ = 14 ‘Сюда​Хотя в голове​ «Не разузлован: «​ думает 15 минут,​ вы не поняли​For i =​

​ каждого упоминания имени​​ …next. работает быстрее​смотри как будет​ «СБ» If InStr(1,​ исходном файле за​If data(i, 3)​
​Dim CompareRange, x​
​ результату т.к. затрачивается​ весь массив и​ "" Then​
​ столбца arr =​
​ будем писать результаты​
​ вертится что-то про​
​ & t, 48,​ это и есть​ в примерах на​
​ 1 To UBound(x)​ в случае если​
​ do...lоор​ выглядеть текстовая упорядоченность​
​ arr2(j, 1) +​
​ 1,5 сек. все​
​ = .Cells(31, j)​ As Range, n,​ много времени на​
​ по оператору ИФ​
​If Колонка2(i, 1)​
​ .Range(.Cells(1, 1), .Cells(ii,​ начиная с 14-й​
​ индексирование полей. Ну​
​ "ВНИМАНИЕ": Exit Sub​
​ суть вопроса и​ форуме? и, кстати,​
​If .Exists(x(i, 1))​ зависимая формула пересчитывается,​22) Точнее объявляй​11​ "СБ", arr1(i, 0),​ общитал​
​ Then​

​ tt​​ обработку, поэтому даже​ (для даты) выбирает​

excelworld.ru

Ускорить работу макроса нахождения кол-ва по трем условиям (Макросы/Sub)

​ If Пусто Then​​ jj)) ‘Весь массив​ строки With Sheets(«лист3»)​ да ладно.​Set r =​ причина для не​ каких именно примерах?​ Then j =​ но это может​ объекты: as commandbutton​2​ vbTextCompare) > 0​А исходный вариант​’Вместо формулы для​tt = Timer​ дождаться не удалось….вот​
​ нужные строки для​
​Set out =​ ячеек сравниваемого листа​
​ 'Заполняем коллекцию для​Из того, что​
​ Sheets("Состав узлов").Cells(ro, 1)​ грубого отступления от​
​Hugo​ j + 1:​ быть проблемой лишь​
​ лучше as control,​
​22​
​ Then If CInt(arr1(i,​ макроса и вариант​ 1-й строки​Application.ScreenUpdating = 0​
​ одно из них​ работы. :) Дооолго​
​ .Offset(i - 1)​
​ предаем в память​ искомых данных ii​
​ я увидел -​x = r.CurrentRegion.Value​
​ правил.​: Александр, мой кажется​ y(j, 1) =​
​ в случае "тяжелых"​
​ еще лучше as​
​и как числовая​
​ 2)) = CInt(arr1(i,​ от​
​result(0, j -​Application.Calculation = xlCalculationManual​
​200?'200px':''+(this.scrollHeight+5)+'px');">Sub Find_Matches()​
​ работает..​Пусто = False​
​ переменой arr 'Лист3​ = .Cells(Rows.Count, 1).End(xlUp).Row​
​ сразу насторожило вот​For j =​Тем более ещё​
​ первый вопрос на​
​ x(i, 1)​
​ расчетов (например точного​ object​2​ 3)) Then 'cравниваем​
​Сани​ 2) = result(0,​
​Set CompareRange =​
​Dim CompareRange As​Но, тут я​
​Else​ уже есть в​
​ 'Определение последней заполненной​ это:​ 1 To UBound(x)​
​ ни кто не​ форумах по Экселю​Next i​ поиска или поиска​
​23) Цикл for​11​
​ числовые значения arr2(j,​от 10 до​
​ j - 2)​ Range("C1:C" & Range("C1:C"​
​ Variant, x As​
​ попал на эту​
​Set out =​ памяти коллекции For​ строки jj =​.Cells(CurR, 1 +​
​s = CStr(x(j,​ нарушил правила! И​ как раз и​End With​ по условиям) хранимых​
​ Еасh..next лучше, чем​22​
​ 2) = arr1(i,​
​ 12 сек.​ + data(i, 7)​
​ & Rows.Count).End(xlUp).Row)​ Variant, y As​
​ тему... и задумался...​ Union(out, .Offset(i -​
​ i = 1​
​ .Cells(1, Columns.Count).End(xlToLeft).Column 'Определение​
​ CurC).Value = s​
​ 3))​
​ нарушать не собирается,​ был «что такое​If j >​ в имени. В​ цикл for…next семейств​

​blackeangel​​ 0) Else arr2(j,​
​Игорь, а обозначения​
​ + data(i, 8)​

​On Error Resume​

​ Variant​ может получится ускорить​
​ 1))​
​ To ii: For​ последнего столбца For​
​ .Cells(CurR, 2 +​
​If d.Exists(s) Then​ если это не​

​ массивы и как​​ 0 Then Range(«B1»).Resize(j).Value​ этом смысле это​ объектов​
​:​ 2) = «нет​ на листе План​ + data(i, 9)​ Next​’ Назначьте переменной​ работу макроса..​End If​ j = 1​ i = 1​
​ CurC).Value = ss​rez(d.Item(s), 4) =​ будет неизбежно.​ с ними работать»​ = y() Else​

​ то же, что​​24) Цикл for​
​fever brain​
​ страниц" End If​
​ (столбец С) могут​'Вместо формул для​
​For Each x​ CompareRange диапазон, с​
​Знатоки, подскажите..​
​End If​ To jj yes​
​ To ii: For​
​ .Cells(CurR, 3 +​

​ rez(d.Item(s), 4) +​​Первый ответ -​​ :)​​ MsgBox «???????? ???»,​ и мой подпункт​ …next лучше, чем​
​, не, нас Буковки​ Else If InStr(1,​
​ повторяться?​

​ диапазона b2:ag29​​ In Selection​ которым​Если я применю​End If​ = 0 For​ j = 1​ CurC).Value = v.Value​

​ x(j, 5) *​​ правилам на форуме​И давалось кстати​ 64​
​ а. в пункте​
​ цикл fог Еасh...next:​
​ сначала сортируются по​ m, arr1(i, 0),​
​китин​For d =​
​n = CompareRange.Find(What:=x)​' нужно сравнить​ автофильтр в макросе,​Next​ try = 3​ To jj For​
​ .Cells(CurR, 4 +​ k​ можно представить аналогию​
​ нелегко, пока понял.​MsgBox Timer -​
​ 1) этого списка.​ для массивов.​
​ алфавиту, затем цифирки​ vbTextCompare) > 0​
​: могут и часто.​
​ 2 To 29'по​
​'e = Err.Number​ выделенный диапазон.​
​ то оператор цикла​End With​
​ To 100 ss​ try = 3​ CurC).Value = Replace(v.Address,​
​Else​ в жизни -​
​ Окно Locals сильно​ tm​6) злоупотреблять конечно​
​25) Использовать оператор​ по возрастанию, а​ Then If CInt(arr1(i,​
​ Там идет разбивка​ строкам с датами​
​If Err.Number =​Set CompareRange =​ ФОР будет перебирать​' Скрыть​ = arr(i, j)​ To 100 s​
​ "$", "")и тому​n = n​
​ закон. Например, УК.​ помогает :)​End Sub​ не стоит, но​
​ With при обращении​ затем снова буковки​ 2)) = CInt(arr1(i,​ по комплектам, а​
​ на листе состав​ 0 Then x.Offset(0,​ Range("C1:C100000")​ только видимые записи​
​With Application​ s = Space(try):​ = Space(try): RSet​ подобное. Конечно будет​ + 1: d.Item(s)​ Интересно, Вашу первую​
​ikki​
​Michael_S​
​ на всякий случай,​
​ к элементам сходной​ или цифирки, если​
​ 3)) Then 'cравниваем​ одно изделие может​For k =​ 1) = x.Value​
​' Примечание. Если​
​ (строки)?​
​.Calculation = xlCalculationManual​
​ RSet s =​
​ s = .Cells(i,​
​ работать часами, если​ = n​
​ отмазку прокурору кто-нибудь​: да не...​: Жаль, не знал,​
​ использование целых столбцов​ иерархической модели​ есть. В результате​ числовые значения arr2(j,​
​ входить в разные​ 16 To 183'по​
​Err.Number = 0​ диапазон ячеек, с​
​Если да, то​.ScreenUpdating = False​
​ ss Err.Clear Set​
​ j).Value Err.Clear: cl.Add​
​ записывать таким образом.​rez(n, 1) =​ пытался когда-то втюхать?​я немножко непраильно​
​ что это кросс​ в функциях точного​Для общих (расшаренных)​ более менее что​ 2) = arr1(i,​
​ комплекты.или просто идти​ столбцам $P$18:$GA$800 на​
​Next x​
​ которыми нужно сравнить​ как этому оператору​
​out.EntireRow.Hidden = True​ v = cl(s)​
​ .Cells(i, j), s​Когда я начинал​
​ n​
​ Если да, что​
​ выразился. сорри.​
​ - не терял​ поиска и функции​
​ книг​

​ то нормальное.​​ 0) Else arr2(j,​ как отдельная еденица​ листе план​

​On Error GoTo​​ выделенные ячейки,​ задать первую и​.Calculation = xlCalculationAutomatic​

​ If Err Then​​ If Err =​ заполнять таблицы, у​rez(n, 2) =​ что прокурор ему​это ни в​​ бы время.​ ИНДЕКС абсолютно не​26) Удалить пользовательские​fever brain​​ 2) = «нет​SLAVICK​If data(2, k)​ 0​’ относится к​ конечную видимую строку?​.EnableEvents = True​​ Exit For 'Эта​ 0 Then Exit​

​ меня тоже работали​​ s​ на это ответил?​ коем случае не​
​У меня макрос​
​ влияет на эффективность​ представления Вид-Представления-Удалить​: В методах баз​
​ страниц" End If​: Думаю еще парочки​
​ = "СБ" And​Application.ScreenUpdating = 1​
​ другой книге или​Казанский​
​End With​ ошибка возникает если​ For 'Выход если​
​ макросы часами.​
​rez(n, 3) =​
​Второй - кто​ "наезд" :)​ на этом же​
​ формулы. В случае​27) Снять пометки​
​ данных должны быть​
​ End If End​ словарей не хватает.​
​ data(1, k) =​
​Application.Calculation = xlCalculationAutomatic​ другому листу, используйте​: > Если я​End Sub​
​ совпадений более нет​
​ ключ не занят​Это, в сущности,​
​ x(j, 4)​
​ мешает в маленьком​
​Slad, конечно, молодец,​
​ принципе и быстродействие​ функций неточного поиска,​
​ с Параметров печати​ и методы поиска​
​ If Else If​
​.​ .Cells(d, 1) Then​
​tt = Timer​
​ приведенный ниже синтаксис.​ применю автофильтр в​
​Комментарии:​
​ yes = 1​
​ Next Next j,​ тоже неплохо -​rez(n, 4) =​ файле просто протянуть​
​ что хотя бы​
​ практически одинаковое (на​ влияние нематериально даже​ и Фильтров ,​но если что...​
​ InStr(1, arr2(j, 1)​
​Кстати - не​result(d - 1,​
​ - tt​
​' Set CompareRange​
​ макросе, то оператор​1. Количество медленных​ With Sheets("лист1") CurC​ i End With​
​ запустил программу и​ x(j, 5) *​ данные тыщ на​
​ слышал о таком​
​ примере с "Залил"​
​ при множестве повторов​ так Рецензировани-Доступ к​ могу скинуть код​
​ + "СБ", arr1(i,​ совсем понял почему:​
​ j - 2)​
​MsgBox "Все" &​ = Workbooks("Book2"). _​
​ цикла ФОР будет​
​ обращений VBA ->​ = (try -​ CommandButton3_Click 'Очистить старые​
​ идёшь пить кофе.​
​ k​
​ 50 строк?.​ чуде и пытался​ - ок. 30​
​ ввиду бинарного алгоритма.​ книге-Параметры печати и​ быстрого поиска половинчатого​ 0), vbTextCompare) >​
​200?'200px':''+(this.scrollHeight+5)+'px');">ReDim result(UBound(data) - 1,​ = result(d -​
​ Chr(10) & "Время​' Worksheets("Sheet2").Range("C1:C100000")​
​ перебирать только видимые​ Excel сокращено за​
​ 3) * 5​
​ результаты With Sheets("лист2")​
​Для ускорения операции​End If​В общем, Правила​ понять/применить...​
​ сек), правда в​ Реально известная проблема​ Фильтры​ деления​ 0 Then If​
​ UBound(data, 1) -​ 1, j -​
​ работы -" &​
​'​ записи (строки)?​
​ счет того, что​ .Cells(CurR, 1 +​
​ ii = .Cells(Rows.Count,​ ввода/вывода надо работать​
​If Left(s, 1)​
​ писал не я,​
​просто я не​
​ том примере повторов​

​ с этим -​​28) Периодически отключать​Public Function BinarySearch(List​ CInt(arr1(i, 2)) =​
​ 1)​ 2) + data(i,​ Format(tt / 24​
​’ В следующем​​Нет. Проверяйте свойство​ диапазоны с условиями​ CurC).Resize(, 4) =​
​ 1).End(xlUp).Row ‘Определение последней​ с образами страниц,​ = 3 Or​ все вопросы к​
​ понимаю, КАК и​ нет — сделал​ опять таки бинарные​​ общий доступ, сохранять​​ As Variant, target​ CInt(arr1(i, 3)) Then​
​Данные на 2-м​ k)​ / 60 /​ цикле каждая выделенная​

​ rows(i).hidden или используйте​​ скопированы в массивы​ Array(s, ss, v.Value,​ заполненной строки jj​ а не с​ Left(s, 1) =​ автору. А я​ ЧТО можно объяснить​

​ принудительно. Единственное отличие​​ условные формулы типа​ книгу, сключать общий​​ As Long) As​
​ ‘cравниваем числовые значения​ листе не всегда​
​End If​ 60, "hhчmmмssс")​ ячейка сравнивается​
​ цикл по видимым​ VBA и там​ Replace(v.Address, «$», «»))​ = .Cells(1, Columns.Count).End(xlToLeft).Column​​ самими страницами.​
​ 6 Then​​ (и остальные модераторы)​ по массивам, если​ — у меня​ СУММПРОИЗВ(…)​ доступ и снова​
​ Long Dim min​ arr2(j, 2) =​
​ будут = количеству​​Next k​End Sub​’ с каждой​ ячейкам, например​ уже анализируются.​
​ End With Next​ ‘Определение последнего столбца​Для этого надо​ertert d, s,​​ слежу за выполнением.​
​ человек УЖЕ покопался​​ не надо отбирать​e_artem​ сохранять​ As Long Dim​ arr1(i, 0) Else​ строк на 1-м​
​Next d​Дмитрий87​​ ячейкой из диапазона​
​Dim c As​​2. Медленное скрытие​ CurR = CurR​ For i =​ использовать свойство​
​ x(j, 5) *​Хотите нарушить, есть​ (не просто «посмотрел»)​ уникальные. и не​: Я ничуть не​

​29) Удостовериться, что​​ max As Long​ arr2(j, 2) =​.​’Вместо формулы для​
​: _Boroda_, очень долго​ CompareRange.​ Range​
​ строк сделано за​ + yes Next​
​ 1 To ii:​​Value​ k​ 2 пути -​ хотя бы в​ важно, в каком​ против, пожалуйста сомневайтесь,​ книга открывается в​

​ Dim middle As​​ «нет страниц» End​​Цитата​​ 30-й строки​ не стал ждать​For Each x​

​For Each c​​ один раз: сначала​ j, i End​ For j =​.​End If​ нарушать в надежде,​ нескольких примерах и​ столбце больше записей.​ опровергайте, предлагайте свои​ режиме просмотра Вид-Обычный​ Long NumSearches =​ If End If​

​китин, 28.07.2016 в​​result(29, j -​китин​ In Selection​ In [A2:A10].SpecialCells(xlCellTypeVisible)​ с помощью Union()​ With Полное_Ускорение 1​ 1 To jj​

​Примерно вот так:​​Next j​ что прокатит или​ — «не разобрался»​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub myDuplikat()​
​ варианты, вообще думаю,​ (для того, чтобы​ 0 min =​ End If Else​ 14:23, в сообщении​ 2) = result(29,​
​: Всем доброго времени​For Each y​
​Однако, метод SpecialCells​
​ определили скрывемый диапазон,​

​ ‘Выключаем полное ускорение​​ yes = 0​Dim ws as​End Sub​ связаться с владельцем​ :(​Dim oDict: Set​ что в направлении​ избежать обращения к​ 1 max =​
​ If arr2(j, 2)​
​ № 10200?’200px’:»+(this.scrollHeight+5)+’px’);»>Я почему​​ j — 2)​ !!!!! Продолжаются попытки​ In CompareRange​ имеет ограничение в​ а затем одним​
​ End Sub​ For try =​ WorkSheet, iR as​ZamoK​ и попросить о​гораздо проще сделать​ oDict = CreateObject(«Scripting.Dictionary»)’​ оптимизации любой момент​

excelworld.ru

Ускорить работу макроса

​ сетевому принтеру с​​ NumItems Do While​ = Empty Then​
​ и сделал поиск​ + data(i, 184)​ хоть как то​If x =​ версиях XL до​ действием скрыли все​blackeangel​ 3 To 100​ Range, v as​: Работает как молния​ разовом исключении.​ готовое решение.​ Создаем словарь​ может быть спортным,​ соответствующими временными последствиями)​ min​ If InStr(1, arr2(j,​ по последнему столбцу​End If​ уменьшить размер и​ y Then x.Offset(0,​ 2007 включительно: он​ строки.​:​ ss = .Cells(i,​ variant Set iR​можно ли как-то​Manyasha​а вот как​Dim Arr(), i​ все зависит от​Для уменьшения размера​результатом будет индекс​ 1), arr1(i, 0),​Добавил размеры диапазона​Next j​ увеличить скорость работы​ 1) = x​ возвращает диапазон не​3. Использование With​fever brain​ j).Value s =​ = ws.Range(ws.Cells(1,1),ws.Cells(1000,1000)) v​ сразу на листе​:​ объяснить?..​Dim t: t​ ситуации​ книги MSE (актуально​ искомого элемента (target)​ vbTextCompare) > 0​ по посл. столбцу.​Next i​ моих огромных файлов.В​Next y​ более 8192 прямоугольных​ rng.Cells(1, 1) позволило​, ну предпологалось, что​ Space(try): RSet s​ = iR.Value ‘​ «Итог» сортировку прикрутить​miver​Hugo​ = Timer:​The_Prist​ для книг в​ в массиве list​ Then For k​Цитата​.Range(«B1:AG30») = result​ свете этого была​Next x​ областей. То есть​ быстрее обращаться к​ все листы в​ = ss Err.Clear​ Снимаем образ -​ по столбцу В​, что мешает Вам​: Да, я сейчас​Arr = Range(«A1:A»​: По формулам массива​ которых часто пишется​blackeangel​ = 1 To​китин, 28.07.2016 в​End With​ предпринята попытка написать​End Sub​ если столбец таблицы​ ячейкам скрывемого диапазона​ памяти будут. То​ Set v =​ двумерный массив. …..​SLAVICK​ заполнить образец файла​ нашёл ту тему​ & Cells(Rows.Count, 1).End(xlUp).Row)​ еще момент: например,​ и удаляется инфа)30)​:​ UBound(massoboz) If InStr(arr2(j,​ 14:23, в сообщении​’Дальше ничего не​ макрос вставки формул​КАК МОЖНО УСКОРИТЬ​ имеет более 16384​ с помощью .Offset(i​ есть лист2 и​ cl(s) If Err​ ‘ Производим какие-то​: Вот:​ тестовыми данными на​ 2009 года -​With oDict​ ТРАНСП, которая вводится​ Перелить одну книгу​fever brain​ 1), massoboz(k, 1))​ № 10200?’200px’:»+(this.scrollHeight+5)+’px’);»>В твоем​ трогала​ в ячейки, копирования​ РАБОТУ, КАК БЫСТРО​ ячеек, надо обрабатывать​ — 1)​ лист3 в память,​ Then Exit For​ операции ….. iR.Value​200?’200px’:»+(this.scrollHeight+5)+’px’);»> With Worksheets(«Итог»)​ несколько тысяч? Код​ мне там тоже​On Error Resume​ разом во все​ в другую путем​, не long а​ > 0 Then​ коде с моим​Dim sh As​ и вставки значений​ ВЫПОЛНИТЬ МОЮ ЗАДАЧУ.​ его кусками по​—​ работаем с ними​ ‘Эта ошибка возникает​ = v ‘​With .Range(«A3:D3»)​ не должен меняться​ не особо объясняли,​ Next​ ячейки будет пересчитываться​ копирования не листа,​ string должно быть,​ arr2(j, 2) =​ багажом(весьма скудным )​ Worksheet, r As​ с последующим уничтожением​ КТО знает или​ 16384 ячейки.​ZVI​ ипосле всех манипуляций​ если совпадений более​

​ сбрасываем образ​​.CurrentRegion.Offset(2).ClearContents​ при изменении кол-ва​
​ просто показали примеры​For i =​ быстрее, чем то​ а содержимого в​ у меня стринговые​

​ «нет сборочного» Exit​​НУ дык форум​ Range​​ нулей(спасибо Ярославу за​​ сталкивался подскажите пожалуйста…!!​
​Или загружайте всю​ZVI​ итог выгружается на​

​ нет yes =​​fever brain​.Resize(n).Value = rez()​ данный.​ кода. Хотя я​ 1 To UBound(Arr)​ же транспонирование через​ новую внигу со​ данные на листе.​ For Else If​ для того и​
​If ActiveWindow.SelectedSheets.Count >​ макрос).Получился вот такой​Оформляйте коды тегами!​ таблицу в массив​

​: —​​ лист1. В результате,​​ 1 With Sheets(«лист1»)​​: Хорошая идея. Запустил​​.Parent.Activate​​ZamoK​
​ уже тогда и​.Add Key:=Arr(i, 1),​ ИНДЕКС, т.к. рассчитывается​ вставкой сначала значения,​ Ищутся в таблице​ CInt(arr1(i, 2)) =​ есть чтоб учится​ 1 Then ‘убираем​ вот монстр ъ​Дмитрий87​ и обрабатывайте средствами​P.S. Заметил свою​
​ никаких ускорителей не​ CurC = (try​

​ программу и ушел​​End With​, правила распространяются на​ сам что-то на​ Item:=True​

​ один раз, а​​ потом формулы, потом​​ со стрингами. Или​​ CInt(arr1(i, 3)) Then​ разбираться​ нули после спецвставка(​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub СУММПР_1()​
​: p/s/ 2 столбец​ VBA.​ опечатку:​ надо, кроме замораживания​ — 3) *​ по своим делам.​With ActiveWorkbook.Worksheets(«Итог»).Sort​

​ всех одинаково, БЕЗ​​ firssteps.ru усвоил, но​Next​
​ ИНДЕКС столько раз,​ форматы и макросы​ все равно?​ ‘cравниваем числовые значения​

​.​​ код от Ярослава)​Dim lLastRow As​ — это столбец​svetlanav​Вместо​ интерфейса, который скроет​ 5 .Cells(CurR, 1​

​Всегда найдется отговорка​​.SortFields.Clear​​ исключений.​​ не совсем…​Arr = Range(«C1:C»​ сколько ячеек задействовано.​

​ через испорт экспорт​​fever brain​ arr2(j, 2) =​Цитата​For Each sh​

​ Long​​ С​​: вы бы выложили​​.EnableEvents = True​​ момент заполнения ячеек​​ + CurC).Value =​ на этот счет​.SortFields.Add Key:=Range(«B3:B» &​SLAVICK​
​Хотя это надо​ & Cells(Rows.Count, 3).End(xlUp).Row)​И во многих​ перенести в новую​
​: Возвращаемое значение это​​ arr1(i, 0) Else​Manyasha, 28.07.2016 в​ In ActiveWindow.SelectedSheets​Dim lLastCol As​Дмитрий87​ листинг?​Должно быть:​ на листе1.​

​ s .Cells(CurR, 2​​blackeangel​ n), SortOn:=xlSortOnValues, Order:=xlAscending,​: Не нужно ничего​ бы усвоить ещё​For i =​ случаях формулы массива,​ книгу​ индекс массива твоего,​ arr2(j, 2) =​

​ 15:58, в сообщении​​Set r =​ Long​: ПРИМЕР — http://zal***il.ru/34278005​i.s.o​
​.ScreenUpdating = True​MU-GK​
​ + CurC).Value =​:​ DataOption:=xlSortNormal​ бросать.​
​ в школе/институте -​ 1 To UBound(Arr)​ введенные разом в​31 ) удалить​
​ поэтому числовой тип​
​ «нет страниц» End​ № 12200?’200px’:»+(this.scrollHeight+5)+’px’);»>у меня​ sh.UsedRange​lLastCol = Cells(31,​ (убрать звёздочки)​

​: Спасибо, понял… У​​—​​: Не в разы​​ ss .Cells(CurR, 3​fever brain​.SetRange Range(«b2:D» &​Вот:​ но не все​If .exists(Arr(i, 1))​ диапазон ячеек быстрее​ избыточное форматирование​
​ long​​ If End If​ на исходном файле​

​r.Replace 0, «»,​​ Columns.Count).End(xlToLeft).Column​Дмитрий87​
​ меня макрос работает​ZVI​ а на несколько​
​ + CurC).Value =​, не ставлю другие​ n)​так должно быть​
​ это изучали. Хотя​ Then .Item(Arr(i, 1))​
​ будут работать, чем​The_Prist: можно поподробнее? Чем​
​если имееш ввиду​
​ Next k End​
​ за 1,5 сек.​
​ xlWhole​
​Sheets(«состав»).Range(«B1»).FormulaLocal = «=СУММПРОИЗВ(План!$G$18:$I$1000*(План!$C$18:$C$1000=состав!B$31))»​
​: Урезать не получиться​
​ с 5 большими​

​Лузер™​​ порядков быстрее.​​ v.Value .Cells(CurR, 4​​ задачи, сейчас я​.Header = xlYes​ быстрее, можно конечно​ бы просто по​ = False​ ввод формулы массива​ же ВПР отличается​ аргумент target то​ If End If​

​ все общитал​​Next​ ‘вставляем формулу в​ т.к пропадёт смысл​
​ таблицами, и если​: Я бы еще​На лист надо​ + CurC).Value =​
​ пробую через запросы​.MatchCase = False​ еще ускорить заменив​ возрасту :)​Next​ в одну ячейку​ от ПОИСКПОЗ так,​ измени на variant​ End If End​а у мну​Else​ 1 строку​
​ примера,- в большом​ загружать эти таблицы​ вместо If v​

​ только сбрасывать готовый​​ Replace(v.Address, «$», «»)​​ всё это хозяйство​​.Orientation = xlTopToBottom​ обращение к листу​Guest​Arr = .keys​ и «тиражирование» её​ что ПОИСКПОЗ по-Вашему​ и все​

​ If Next j​​ практически мгновенно.​If MsgBox(«Заменить 0​Range(«B1»).Select​ кол-ве значений и​
​ в массивы, и​ = «» Then​ результат.​ End With Next​

CyberForum.ru

​ прокрутить. Пока что​

To achieve the best VBA code performance after compilation with DoneEx VbaCompiler for Excel, we recommend to apply all of the following tips to optimize VBA code performance before compilation.

1. Turn off “Automatic Calculation” mode and enable “Manual Calculation” mode

The Application.Calculation property allows you to control Excel’s calculation mode from your VBA code.

Automatic (xlCalculationAutomatic) mode is the default value of Application.Calculation property and it means that Excel controls the calculation and decides when to trigger the calculation of the workbook (e.g. when a new formula is entered, a cell value is changed, or the value of the Range object is changed from VBA code).

Manual (xlCalculationManual) mode means Excel waits for the user action (or action from your VBA code) to explicitly begin calculation.
Since recalculating a workbook takes time and resources, then to increase the VBA code calculation performance it is better to set the Application.Calculation property to manual mode.

Turn off the automatic calculation mode while your VBA code is running, and then set the mode back when it’s done to increase the VBA performance.

Example:

Dim savedCalcMode As XlCalculation
savedCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual
< ... your code here ... >
Application.Calculation = savedCalcMode

2. Turn off “Screen Updating”

The Excel Application.ScreenUpdating property controls the re-drawing of the Excel screen’s visible parts. The Excel spends some resources to draw the screen during re-calculation. You will get noticeable performance improvements by switching off the Application.ScreenUpdating property by setting it to False.

Example:

Dim savedScreenUpdating as Boolean
savedScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
< ... your code here ... >
Application.ScreenUpdating = savedScreenUpdating

3. Disable Application.EnableEvents

In most cases you do not want to allow the Excel to process events while the VBA code is running because it slows calculation.

Example:

Dim savedEnableEvents as Boolean
savedEnableEvents = Application.EnableEvents
Application.EnableEvents = False
< ... your code here ... >
Application.EnableEvents = savedEnableEvents

4. Turn off ActiveSheet.DisplayPageBreaks

Another way to speed up your VBA code is by disabling the ActiveSheet.DisplayPageBreaks property.

Example:

Dim savedPageBrakes as Boolean
savedPageBrakes = ActiveSheet. DisplayPageBreaks
ActiveSheet. DisplayPageBreaks = False
< ... your code here ... >
ActiveSheet. DisplayPageBreaks = savedPageBrakes

5. Disable animation in Excel by “Application.EnableAnimations = False”

Animations are enabled for user actions and representations, beautifying Excel. Disabling these animations allows for the improvement of VBA performance.

Example:

Dim savedEnableAnimations as Boolean
savedEnableAnimations = Application.EnableAnimations
Application.EnableAnimations = False
< ... your code here ... >
Application.EnableAnimations = savedEnableAnimations

6. Turn off status bar by “Application.DisplayStatusBar = False”

Disabling the status bar frees up resources for VBA calculation and improves VBA calculation performance.

Example:

Dim savedStatusBar as Boolean
savedStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = False
< ... your code here ... >
Application.DisplayStatusBar = savedStatusBar

7. Turn off “Print Communication”

Disabling Application.PrintCommunication property also speeds up VBA execution.

Example:

Dim savedPrintCommunication as Boolean
savedPrintCommunication = Application.PrintCommunication
Application.PrintCommunication = False
< ... your code here ... >
Application.PrintCommunication = savedPrintCommunication

8. Use OptimizedMode() procedure to enable optimization

The best way to use the actions from the tips above is to combine them all into one procedure which allows you to enable an optimized VBA calculation mode with a single call before executing your VBA code and disabling it all with one call after that.

Here you may find the full OptimizedMode procedure definition.

Public Sub OptimizedMode(ByVal enable As Boolean)
     Application.EnableEvents = Not enable
     Application.Calculation = IIf(enable, xlCalculationManual, xlCalculationAutomatic)
     Application.ScreenUpdating = Not enable
     Application.EnableAnimations = Not enable
     Application.DisplayStatusBar = Not enable
     Application.PrintCommunication = Not enable
End Sub

Usage Example:

OptimizedMode True
< ... your code here ... >
OptimizedMode False

9. Avoid selecting and activating methods

Select and Activate methods are slow methods and add a time overhead during calculation.

For example:
Instead of using ‘Select’ method and ‘Selection’ object, like:

ActiveSheet.Select
Selection.Range("A1").Value2 = "text"

Use direct access to the object without unnecessary selection:

ActiveSheet.Range("A1").Value2 = "text"

10. Avoid recording macro

VBA code generated from macro recording has low performance efficiency because it uses a lot of Select and Selection methods.

11. Avoid unnecessary Copy/Paste operations

Copy/Paste operations may seem appropriate for many algorithm situations, but it is very ineffective for VBA code performance.

Instead of the code:

Worksheets("Sheet1").Range("A1:H10").Copy
Worksheets("Sheet2").Range("A1").PasteSpecial

Use the following code:

Sheet2.Range("A1:H10").Value2 = Sheet1.Range("A1:H10").Value2

12. Use “ForEach” loop instead of “indexed For” loop for collections

When a collection object is traversed in an indexed For loop, each item in the collection is accessed through an index operation, which is much slower than traversing each object in the collection one-by-one in the ‘For Each’ loop.

Instead of code like:

For i=1 to Collection.Count
    Collection.Item(i).Value = value
Next 

Use following approach:

For Each obj in Collection
    Obj.Value = value
Next

13. Use “With … End” statement

Use the With…End statement instead of full qualified access to the object’s methods or data.

Instead of:

ThisWorkbook.Worksheets("Sheet1").Range("A1").Font.Bold = True
ThisWorkbook.Worksheets("Sheet1").Range("A1").Value2 = 100

Use the following code:

With ThisWorkbook.Worksheets("Sheet1").Range("A1")
    .Font.Bold = True
    .Value = 100
End With

14. Use simple objects rather than compound objects

For the same reason as in the previous advice, you can reduce the time overhead for accessing the qualified object’s method by assigning a complex qualified name to a separate object and use that object for accessing the object’s methods.

Instead of:

ThisWorkbook.Worksheets("Sheet1").Range("A1").Font.Bold = True
ThisWorkbook.Worksheets("Sheet1").Range("A1").Value2 = 100

Use the following code:

Dim rng as Range
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1")
Rng.Font.Bold = True
Rng.Value2 = 100

15. Use vbNullString instead of an empty string

Technically vbNullString is not a string – it is a constant declared as a Null pointer. When you use vbNullString instead of empty string (“”) you avoid some extra memory allocations which give time overheads.

Instead of assignment like this:

 Dim Str as String
 Str = ""

Use this:

 Dim Str as String
 Str = vbNullString

16. Use “Early Binding” instead of “Late Binding”

Binding is a process of coupling the object variable with its content. After the binding, the variable represents the object and allows it to get access to the methods and data of the object.
For detailed explanation of the difference between ‘Early binding’ and ‘Late Binding’ please read the following articles:
Early vs. Late Binding
Using early binding and late binding in Automation

Example of “Late binding”:

Dim obj as Object
Set obj = CreateObject("Excel.Application")

Example of “Early Binding”:

Dim xlApp as Excel.Application
Set xlApp = New Excel.Application

17. Avoid using Variant type

Variant type is a dynamic type – that means Variant variables can accept any other type of data and store it. Usage of the Variant type may be comfortable and time saving for programming time, but it sacrifices time overhead during run-time (when your code is working) because conversion from exact type to Variant and from Variant to any other type is time consuming.
For example: If the data has a ‘String’ type it should be stored into the variable which is declared with a String type but not into a Variant type variable, also it makes sense for all other types.

Also avoid declaration like:

 Dim v

The variable ‘v’ in code line above is declared as Variant because declaration of type is missed.

 Dim a, b, c as Long

In this code example only the ‘c’ variable is declared as Long, but ‘a’ and ‘b’ are declared as Variant.
To declare all variables in one line you need to point out the exact type for each variable declaration, like so:

 Dim a as Long, b as Long, c as Long

18. Avoid declaration of method parameters without type

Instead of:

Private Sub Proc1(a,b,c)

Use exact type declaration for each parameter:

Private Sub Proc1(ByVal a as Long, ByVal b as String, ByVal c as Integer)

19. Use ‘Option Explicit’

If you miss the variable declaration it will be assumed by VBA as variable with Variant type.

Following to the previous tip it is better to avoid Variant typed declarations if you want to maximize your VBA code performance.

By default, the VBA do not warn you that variable is not declared. To avoid this situation, use the ‘Option Explicit’ statement in the first line of each VBA module in your VBA project.

With the ‘Option Explicit’ statement, VBA will warn about any undeclared variable.

20. Avoid using Object type, use specific object type declarations

When you use the Object type, VBA does not know what exact type object it contains and will resolve this during run-time (when your code is working) which will take additional time. To avoid this overhead time, you need to use the exact type of variable for declaration.

Instead of code:

Dim obj as Object
Set obj = New Collection

Use following code:

Dim oCollection as Collection
Set oCollection = New Collection

21. Use “Const” for constant declarations

Declare constant instead of variable if you need to have a constant.

Use constant declaration:

Const pi as Double = 3.14159265359

Instead of following:

Dim pi as Double
Pi = 3.14159265359

22. Use ByVal modifiers for parameters

When you do not need to return value from the method parameter then explicitly declare this parameter as ByVal.

Use this:

Private Sub Proc1(ByVal a as Long)

Instead of:

Private Sub Proc1(a as Long)

23. Move out unnecessary actions from a loop body

Each unnecessary action inside a loop will be repeated and it will accumulate overhead time for algorithm. By removing such pieces of code from loop body you optimize VBA code.

For example, instead of the following code:

Dim rng as Range
For Each rng in Worksheets("Sheet1").Range("A1:AA100")
    Dim result as Range
    Set result = Worksheets("Sheet2").Range("A1")
    result.Value2 = result.Value2 + rng.Value2
Next

Use this code:

Dim result As Double
Dim rng As Range
For Each rng In Worksheets("Sheet1").Range("A1:AA100")
    result = result + CDbl(rng.Value2)
Next
Worksheets("Sheet3").Range("A1").Value2 = result

24. Use String versions of built-in functions instead of the Variant version

If you are working with VBA string functions, it is better to use String typed version functions – which have a ‘$’ dollar sign in the suffix instead of the Variant typed version of the same functions.

Instead of these functions:

Chr(), ChrB(), ChrW(), Error(), Format(), Hex(), LCase(), Mid(), MidB(), Left(), LeftB(), 
LTrim(), Oct(), RightB(), Right(), RTrim(), Space(), Str(), String(),Trim(), UCase() 

Use these string version functions:

Chr$(), ChrB$(), ChrW$(), Error$(), Format$(), Hex$(), LCase$(), Mid$(), MidB$(), Left$(),
LeftB$(), LTrim$(), Oct$(), RightB$(), Right$(), RTrim$(), Space$(), Str$(), String$(),
Trim$(), UCase$()

25. Minimize data exchange between Worksheet and VBA code

Use an array to collect big range data and traverse through the array rather than a Worksheet range, cell by cell. This optimize VBA code tip allows to improve the performance more than 1o times.

Instead of this approach:

Function CalcSlow() As Double
    Dim cell As Range
    For Each cell In Sheet1.UsedRange
        If IsNumeric(cell.Value) Then
            CalcSlow = CalcSlow + cell.Value
        End If
    Next
End Function

Use this approach:

'the CalcFast() works more than x10 times faster of CalcSlow()
Function CalcFast() As Double
    Dim arrCells() As Variant
    Dim val As Variant
    arrCells = Sheet1.UsedRange.Value2
    For Each val In arrCells
        If IsNumeric(val) Then
            CalcFast = CalcFast + CDbl(val)
        End If
    Next
End Function