Приветствую! Решил протестировать скорость различных действий при работе с диапазонами и показать некоторые способы ускорения
Адреса
GetAddress
Выводы: Адрес более, чем в 2 раза быстрее получать через Cells Адрес "без долларов" получать также быстро, как и с ними (по умолчанию) Положение ячейки на листе не влияет на скорость получения адреса
CalculateAddress
Выводы: Получать адрес из переменной диапазона чуть быстрее, чем через Cells Для больших областей вычислять адрес быстрее в ДЕСЯТЬ раз, чем получать его из свойств диапазона (это не предел: чем больше столбцов в каждой области, тем быстрее) В самом плохом случае 15 тыс отдельных ячеек (15 тыс раз определять литеры столбца по его номеру) метод вычисления адреса НЕ МЕДЛЕННЕЕ его получения из свойств Преимущество очевидно
Для чего (старые песни о главном)
Следите за логикой: ЛИТЕРЫ столбца по его номеру нужно, чтобы БЫСТРЕЕ получать АДРЕС любой ячейки АДРЕС ячейки нужно получать, чтобы собирать одномерный массив таких АДРЕСОВ ячеек, подходящих по какому-либо критерию Одномерный МАССИВ адресов потом быстро (Join(arr,",")) можно сцепить в длиннющую СТРОКУ адресов и передать в Функция "нарежет эту" СТРОКУ на БЛОКИ адресов с количеством символов максимально близко (но не более) к 255 символам Каждый такой БЛОК эта же функция преобразует в ДИАПАЗОН (Set rng = Sheet().Range(adrBlock$)), и сохранит в МАССИВ АДРЕСОВ Результатом работы функции нарезки будет МАССИВ АДРЕСОВ arrRng() As Range, по которому можно пробежать в цикле и сделать с полученным диапазоном, что нужно (покрасить/обесцветить, очистить, заполнить одинаковыми значениями, установить формат и так далее)
На сегодняшний момент - это наибыстрейший способ подобной работы с диапазонами, дающий ощутимый и (при росте объёмов) кратный прирост в скорости Если же вам нужно ВЫДЕЛИТЬ какой-либо диапазон по критерию, то данный метод даст прирост в сотни и тысячи раз Для себя я его запомнил как UnionCut, то есть замена ОЧЕНЬ медленной Union очень быстрой резкой строки AdrCut
Interior and NumberFormat
Выводы: Заливка более, чем в 2 раза медленнее считывания заливки Установка формата (сложного) в ДЕСЯТЬ раз медленнее заливки Считывание формата ячейки немного быстрее, чем считывание заливки
Очевидно, что, для "создания" заливки и, ОСОБЕННО, формата нужно собирать подходящие ячейки в группы и только работать с "комплектами"
Сравнение
Коды
AdrGet
Код
Option Explicit
Option Private Module
'====================================================================================================
Const nMax& = 100000
'====================================================================================================
Sub TesterAdrGet()
Dim x, t!, r&
t = Timer
For r = 1 To nMax
x = Cells(r, 1).Address
Next r
Debug.Print "Cells", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
For r = 1 To nMax
x = Cells(r, 1).Address(0, 0, xlA1)
Next r
Debug.Print "CellsA1", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
For r = 1 To nMax
x = Range("A" & r).Address
Next r
Debug.Print "Range", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
For r = 1 To nMax
x = Range("A" & r).Address(0, 0, xlA1)
Next r
Debug.Print "RangeA1", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
For r = 1 To nMax
x = Cells(1, 1).Address
Next r
Debug.Print "CCycle1", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
For r = 1 To nMax
x = Cells(1000000, 10000).Address
Next r
Debug.Print "CCycle2", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
For r = 1 To nMax
x = Range("A1").Address
Next r
Debug.Print "RCycle1", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
For r = 1 To nMax
x = Range("NTP1000000").Address ' NTP = 10k column
Next r
Debug.Print "RCycle2", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
End Sub
'====================================================================================================
'====================================================================================================
AdrSmart
Код
Option Explicit
Option Private Module
'====================================================================================================
'====================================================================================================
Sub TesterAdrSmart()
Dim rng As Range
Dim x, arr, ltr$, t!, r&, c&
Set rng = Cells(1, 1).Resize(10000, 100): arr = rng.Value2
t = Timer
For c = 1 To UBound(arr, 2)
For r = 1 To UBound(arr, 1)
x = rng(r, c).Address
Next r
Next c
Debug.Print "Range", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
For c = 1 To UBound(arr, 2)
For r = 1 To UBound(arr, 1)
x = Cells(r, c).Address
Next r
Next c
Debug.Print "Cells", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
For c = 1 To UBound(arr, 2)
ltr = RangeColumnConvert_NumToLtr(c)
For r = 1 To UBound(arr, 1)
x = ltr & r
Next r
Next c
Debug.Print "Calculate", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
For r = 1 To 100
For c = 1 To 15000
x = Cells(1, c).Address
Next c
Next r
Debug.Print "ByOneAdr", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
For r = 1 To 100
For c = 1 To 15000
x = RangeColumnConvert_NumToLtr(Cells(1, c).Column) & 1
Next c
Next r
Debug.Print "ByOneCalc", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
End Sub
'====================================================================================================
' Функции преобразования номера столбца в его буквы взяты отсюда: https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=140652&TITLE_SEO=140652-kak-opredelit-bukvy-stolbtsa-po-ego-nomeru&MID=1139439#message1139439
'====================================================================================================
Function RangeColumnConvert_NumToLtr(ByVal nCol&) As String
Dim ch&, i&
Static a(1 To 16384) As String, fStatic As Boolean
If Not fStatic Then
fStatic = True
For ch = 65 To 90
i = i + 1: a(i) = Chr$(ch)
Next ch
For i = 27 To 16384
a(i) = ColToLtr(i)
Next i
End If
RangeColumnConvert_NumToLtr = a(nCol)
End Function
'----------------------------------------------------------------------------------------------------
Private Function ColToLtr(nCol&) As String
Dim cQUO As Long, cMOD As Long, cQUO2 As Long, cMOD2 As Long
If nCol <= 702 Then
cQUO = nCol \ 26
cMOD = nCol Mod 26
If cMOD = 0 Then cQUO = cQUO - 1: cMOD = 26
ColToLtr = Chr$(cQUO + 64) & Chr$(cMOD + 64)
Else
cQUO = nCol \ 26
cMOD = nCol Mod 26
cQUO2 = (nCol - 26) \ 676
cMOD2 = (nCol - 26) Mod 676
If cMOD2 = 0 Then cQUO2 = cQUO2 - 1
If cMOD = 0 Then cQUO = cQUO - 1: cMOD = 26
ColToLtr = Chr$(cQUO2 + 64) & Chr$((cQUO - cQUO2 * 26) + 64) & Chr$(cMOD + 64)
End If
End Function
'====================================================================================================
IntFrmt
Код
Option Explicit
Option Private Module
'====================================================================================================
Const nMax& = 100000
'====================================================================================================
Sub TesterIntFrmt()
Dim x, tx$, t!, r&
t = Timer
For r = 1 To nMax
x = Cells(r, 1).Interior.Color
Next r
Debug.Print "IntGetNone", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
'--------------------------------------------------------------------------------------------------
For r = 1 To nMax
Cells(r, 1).Interior.Color = vbYellow
Next r
Debug.Print "IntSet", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
'--------------------------------------------------------------------------------------------------
For r = 1 To nMax
x = Cells(r, 1).Interior.Color
Next r
Debug.Print "IntGetYel", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
'====================================================================================================
For r = 1 To nMax
x = Cells(r, 1).NumberFormat
Next r
Debug.Print "FrmtGetGen", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
'--------------------------------------------------------------------------------------------------
tx = "$#,##0.00_);[Red]($#,##0.00)"
For r = 1 To nMax
Cells(r, 1).NumberFormat = tx
Next r
Debug.Print "FrmtSet", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
'--------------------------------------------------------------------------------------------------
For r = 1 To nMax
x = Cells(r, 1).NumberFormat
Next r
Debug.Print "FrmtHard", Format$(1000 * (Timer - t), "#,##0 ms"): t = Timer
'====================================================================================================
Columns(1).Interior.ColorIndex = xlNone
Columns(1).NumberFormat = "General"
End Sub
'====================================================================================================
'====================================================================================================
