Range.Address / Union(Ranges). Как максимально быстро отобрать диапазон по критериям

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

10.03.2021 10:47:27

Приветствую!

Данная тема плавно вытекает из обсуждения «Range.Address. Зачем собирать адреса, Области применения» и, собственно, отвечает на этот вопрос - то есть показывает пример успешного применения сбора адресов для решения конкретной задачи.
Кроме демонстрации эффективности работы с адресами, в методе использована универсальная функция для максимально эффективного объединения диапазонов
Итоги проделанной работы (+ метод быстрого удаления большого количества строк)

Функции сделаны достаточно универсальными без заметной потери в скорости - использование не должно вызвать проблем

ВАЖНО: перед тестированием функций, посмотрите хоть немного, с чем она работает и откуда берёт входящие данные — это всегда диапазон листа и он должен быть заполнен. Не заполнил сам, чтобы не превысить размер файла

Принцип:

Модуль «TestDel» (удаление строк)

Модуль «TestInt» (заливка ячеек)

Код

Option Explicit
Option Private Module
'====================================================================================================
Sub TestInterrior()    ' Test on 187 468 cells, selected from range (best: ~ 3.5 sec)
Dim rng As Range
Dim x, arr, arrR() As Range
Dim adr$, t!, tt!, ttt!, r&

ttt = Timer: t = Timer
Set rng = shInt.UsedRange
rng.Interior.ColorIndex = xlNone
Debug.Print "Prepare:", Format$(Timer - t, "0.00 sec")

t = Timer
adr = GetAddress(rng)
Debug.Print "Get Address:", Format$(Timer - t, "0.00 sec"): Debug.Print String$(100, "=")

' ===== Paint ONE Range block               = 8.4 sec (3rd place)
tt = Timer
t = Timer   ' Cut Address to Range Array    ~ 2.2 sec
arrR = PRDX_AddressToRanges(shInt, adr)
Debug.Print "Get Ranges:", Format$(Timer - t, "0.00 sec")

t = Timer   ' Paint ONE Range               ~ 6.2 sec
PRDX_UnionArray(arrR).Interior.Color = vbYellow
Debug.Print "Paint Whole:", Format$(Timer - t, "0.00 sec")
Debug.Print "• whole:", Format$(Timer - tt, "0.00 sec"): Debug.Print String$(100, "=")
' ===== END block

' ===== CP cycle block (2.9 sec)            = 2.9 sec (1st place)
tt = Timer
t = Timer   ' Cut Address to Range Array    ~ 2.2
arrR = PRDX_AddressToRanges(shInt, adr)
Debug.Print "Get Ranges:", Format$(Timer - t, "0.00 sec")

t = Timer   ' Paint Ranges in Array         ~ 0.7 sec
    For Each x In arrR
        x.Interior.Color = vbYellow
    Next x
Debug.Print "Paint Array:", Format$(Timer - t, "0.00 sec")
Debug.Print "• cycle:", Format$(Timer - tt, "0.00 sec")
' ===== END block

t = Timer  ' Cut & Paint                    = 3.17 sec (2nd place)
PRDX_AddressPaint shInt, adr
Debug.Print "• simple:", Format$(Timer - t, "0.00 sec")

Debug.Print "Total time:", Format$(Timer - ttt, "0.00 sec")
End Sub
'====================================================================================================
Function GetAddress(rng As Range) As String
Dim arr, arrOut()
Dim i&, r&, c&

ReDim arrOut(rng.Count - 1)
arr = rng.Value: i = -1
    For c = 1 To UBound(arr, 2)
        For r = 1 To UBound(arr, 1)
            If arr(r, c) < 1500 Then i = i + 1: arrOut(i) = rng(r, c).Address(0, 0, xlA1)
        Next r
    Next c
Debug.Print "Cells Find:", i + 1
ReDim Preserve arrOut(i): GetAddress = Join(arrOut, ",")
End Function

Модуль «PRDX» (мои функции для работы)

Код

Option Explicit
Option Private Module
'====================================================================================================
Const UnMax& = 30
'====================================================================================================
' Функция принимает лист и строку адресов с этого листа в виде одномерного массива, а возвращает массив "укрупнённых" адресов
' Например передаём массив адресов 1 млн отдельных ячеек (отобрали по какому-либо критерию с листа); это ~6 символов на каждый + 1 млн запятых в разделителях = строка 7 млн символов
' Функция вернёт массив ДИАПАЗОНОВ примерно в ~ 27,5 тыс штук (7 млн / 255 символов)
' Красить в цикле 1 миллион диапазонов/ячеек или 27,5 тысяч - это разница в десятки и сотни раз по времени (например, 1 секунда вместо 2ух минут)
' Скорость резки на строковых функциях просто фантастическая - 3 секунды на 200 тыс адресов отдельных ячеек
' Union при таком количестве диапазонов нам не помощник. Даже максимально эффективная его версия. Можно считать "резку строки" своеобразным супер-Union'ом

Function PRDX_AddressToRanges(sh As Worksheet, ByVal txAdr$) As Range()
Dim arrRanges() As Range, r&, i&
Const maxLen& = 255
'Const maxLen& = 50 ' тестировал резку на блоки разной длины

If InStr(txAdr, "$") Then txAdr = Replace$(txAdr, "$", "")
i = Len(txAdr)

    If i < maxLen + 1 Then
        ReDim arrRanges(0): Set arrRanges(0) = sh.Range(txAdr)
        PRDX_AddressToRanges = arrRanges: Exit Function
    End If

r = -1: ReDim arrRanges(i \ (maxLen \ 2))                           ' создаём массив для хранения с запасом
    Do
        i = InStrRev(Left$(txAdr, maxLen), ",")                     ' ищем запятую с конца первых 255 символов взятой строки
        r = r + 1: Set arrRanges(r) = sh.Range(Left$(txAdr, i - 1)) ' заполняем массив диапазонов
        txAdr = Mid$(txAdr, i + 1)                                  ' отрезаем от адресной строки использованный фрагмент (взятая строка)

        If Len(txAdr) < maxLen + 1 Then                             ' если остаток строки можно сразу преобразовать в диапазон, то заканчиваем и выходим
            r = r + 1: Set arrRanges(r) = sh.Range(Left$(txAdr, i - 1))
            ReDim Preserve arrRanges(r): PRDX_AddressToRanges = arrRanges
            Exit Function
        End If
    Loop
End Function
'----------------------------------------------------------------------------------------------------
' Процедура для закрашивания диапазонов сразу при резке строки (просто для примера и теста скорости)
Sub PRDX_AddressPaint(sh As Worksheet, ByVal txAdr$)
Dim i&

If InStr(txAdr, "$") Then txAdr = Replace$(txAdr, "$", "")
i = Len(txAdr): If i < 256 Then sh.Range(txAdr).Interior.Color = vbYellow: Exit Sub
    Do
        i = InStrRev(Left$(txAdr, 255), ",")
        sh.Range(Left$(txAdr, i - 1)).Interior.Color = vbYellow
        txAdr = Mid$(txAdr, i + 1)
        If Len(txAdr) < 256 Then sh.Range(txAdr).Interior.Color = vbYellow: Exit Sub
    Loop
End Sub
'====================================================================================================
'====================================================================================================
' Функция объединяет все диапазоны переданного массива в один диапазон, который и возвращает
Function PRDX_UnionArray(arrRng() As Range) As Range
Dim i&, j&, n&

    Do
        j = -1
        For i = 0 To UBound(arrRng) Step UnMax
            j = j + 1
            Set arrRng(j) = PRDX_UnionSmart(arrRng, i)
        Next i

        ReDim Preserve arrRng(j)
        If j < UnMax Then Set PRDX_UnionArray = PRDX_UnionSmart(arrRng): Exit Function
    Loop
End Function
'----------------------------------------------------------------------------------------------------
' Функция для "умного" объединения диапазонов из переданного массива с помощью Union
' Основной смысл — объединять по 30 диапазонов за раз (максимум для Union). Реже вызов Union = выше скорость
' Функция получает массив диапазонов и индекс элемента, с которого нужно начать объединения (первый элемент массива с индексом 0 - по умолчанию)
' Функция постарается максимально "забить" Union всеми 30ю аргументами-диапазонами, а, если их меньше, то всеми оставшимися
Function PRDX_UnionSmart(arrRng() As Range, Optional iStart&) As Range
Dim s&, n&

s = iStart
n = UBound(arrRng) - s + 1 ' количество элементов от стартового и до конца массива
If n > UnMax Then n = UnMax
If n = UnMax Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17), arrRng(s + 18), arrRng(s + 19), arrRng(s + 20), arrRng(s + 21), arrRng(s + 22), arrRng(s + 23), arrRng(s + 24), arrRng(s + 25), arrRng(s + 26), arrRng(s + 27), arrRng(s + 28), arrRng(s + 29)): Exit Function

    If n < 14 Then
        If n = 1 Then Set PRDX_UnionSmart = arrRng(s): Exit Function
        If n = 2 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1)): Exit Function
        If n = 3 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2)): Exit Function
        If n = 4 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3)): Exit Function
        If n = 5 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4)): Exit Function
        If n = 6 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5)): Exit Function
        If n = 7 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6)): Exit Function
        If n = 8 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7)): Exit Function
        If n = 9 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8)): Exit Function
        If n = 10 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9)): Exit Function
        If n = 11 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10)): Exit Function
        If n = 12 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11)): Exit Function
        If n = 13 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12)): Exit Function
    Else
        If n = 14 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13)): Exit Function
        If n = 15 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14)): Exit Function
        If n = 16 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15)): Exit Function
        If n = 17 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16)): Exit Function
        If n = 18 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17)): Exit Function
        If n = 19 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17), arrRng(s + 18)): Exit Function
        If n = 20 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17), arrRng(s + 18), arrRng(s + 19)): Exit Function
        If n = 21 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17), arrRng(s + 18), arrRng(s + 19), arrRng(s + 20)): Exit Function
        If n = 22 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17), arrRng(s + 18), arrRng(s + 19), arrRng(s + 20), arrRng(s + 21)): Exit Function
        If n = 23 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17), arrRng(s + 18), arrRng(s + 19), arrRng(s + 20), arrRng(s + 21), arrRng(s + 22)): Exit Function
        If n = 24 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17), arrRng(s + 18), arrRng(s + 19), arrRng(s + 20), arrRng(s + 21), arrRng(s + 22), arrRng(s + 23)): Exit Function
        If n = 25 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17), arrRng(s + 18), arrRng(s + 19), arrRng(s + 20), arrRng(s + 21), arrRng(s + 22), arrRng(s + 23), arrRng(s + 24)): Exit Function
        If n = 26 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17), arrRng(s + 18), arrRng(s + 19), arrRng(s + 20), arrRng(s + 21), arrRng(s + 22), arrRng(s + 23), arrRng(s + 24), arrRng(s + 25)): Exit Function
        If n = 27 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17), arrRng(s + 18), arrRng(s + 19), arrRng(s + 20), arrRng(s + 21), arrRng(s + 22), arrRng(s + 23), arrRng(s + 24), arrRng(s + 25), arrRng(s + 26)): Exit Function
        If n = 28 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17), arrRng(s + 18), arrRng(s + 19), arrRng(s + 20), arrRng(s + 21), arrRng(s + 22), arrRng(s + 23), arrRng(s + 24), arrRng(s + 25), arrRng(s + 26), arrRng(s + 27)): Exit Function
        If n = 29 Then Set PRDX_UnionSmart = Union(arrRng(s), arrRng(s + 1), arrRng(s + 2), arrRng(s + 3), arrRng(s + 4), arrRng(s + 5), arrRng(s + 6), arrRng(s + 7), arrRng(s + 8), arrRng(s + 9), arrRng(s + 10), arrRng(s + 11), arrRng(s + 12), arrRng(s + 13), arrRng(s + 14), arrRng(s + 15), arrRng(s + 16), arrRng(s + 17), arrRng(s + 18), arrRng(s + 19), arrRng(s + 20), arrRng(s + 21), arrRng(s + 22), arrRng(s + 23), arrRng(s + 24), arrRng(s + 25), arrRng(s + 26), arrRng(s + 27), arrRng(s + 28)): Exit Function
    End If

MsgBox "UNcorrect ranges!", vbCritical, "UnionSmart"
Err.Raise xlErrNA
End Function
'====================================================================================================
'====================================================================================================

Предлагаю новое название для темы:
«Диапазоны (Ranges). Как быстро отобрать области и/или удалить строки по критериям»

Прикрепленные файлы

Union(Ranges).xlsb (91.79 КБ)

Изменено: Jack Famous - 12.03.2021 10:00:54

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

bedvit

Пользователь

Сообщений: 2629 Регистрация: 02.04.2015

Виталий

10.03.2021 11:13:36

Алексей, уже третья тема на Range.Address, может просто нужно в первой все обосновать?
А по теме, уже была тема:
Максимальная производительность при поиске и выделении (Select) большого массива несвязанных ячеек по условию - VBA
Это не одно и тоже, зачем новая тема?

Изменено: bedvit - 10.03.2021 11:15:19

«Бритва Оккама» или «Принцип Калашникова»?

БМВ

Модератор

Сообщений: 23300 Регистрация: 28.12.2016

Excel 2013, 2016

10.03.2021 11:16:11

И пришел медведь.

Во время разработки космической программы, NASA столкнулась с проблемой: обыкновенные шариковые ручки не пишут в невесомости. И тогда агентство привлекло лучших учёных страны, и потратило несколько миллионов долларов налогоплательщиков для того, чтоб разработать специальную "космическую ручку". Это чудо техники могло писать в невесомости и вакууме, на жаре и на морозе, и вообще являлось лучшей ручкой времён и народов. А советское руководство тем временем снабдило своих космонавтов простыми и дешёвыми карандашами.

По вопросам из тем форума, личку не читаю.

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

10.03.2021 11:21:11

Цитата
bedvit: уже третья тема на Range.Address, может просто нужно в первой все обосновать?

первая про то, как получить адрес диапазона, состоящего из множества областей (и её превратили в помойку - отдельное "спасибо"), вторая - в Курилке и про обсуждение "зачем", нежели про конкретные способы. Эта же тема — с готовыми решениями: "Бери и пользуйся", как говорит Николай Владимирович

Цитата
bedvit: по теме, уже была тема

ну да - тут без пузыря даже пытаться не надо разобраться

Код

'разработка от: bvv(bedvit)
'для форума: http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=75360
'версия 4 от 18/03/2016
Option Explicit
  Sub Выделить_по_условию4()
  Dim i&, j&, k&, addr$, s$(1 To 17, 1 To 30), x&, y&, t#, xEnd&, yEnd&, ac&, aa, aa1, L&, CName$(), c&, UR, UR1 'i2&, j2&,
  Call заполнить_лист 'заполняем листы для работы макроса, если уже заполнены можно закоментировать
  t = Timer
  xEnd = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 'задаем нижние границы диапазона строк
  yEnd = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1 'задаем нижние границы диапазона столбцов
  If xEnd + yEnd = 2 Then Exit Sub
 
  With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: ac = .Calculation: .Calculation = -4135: End With
  ReDim CName(1 To yEnd)
  For c = 1 To yEnd ' Создать массив имен столбцов
    CName(c) = Split(Cells(1, c).Address, "$")(1)
  Next
  
  Set aa = Range(Cells(1, 1), Cells(xEnd, yEnd)): aa1 = aa.Value
  For y = 1 To yEnd
    For x = 1 To xEnd
    '========================================
      If aa1(x, y) > 1500 Then 'ЗАДАЕМ УСЛОВИЕ
    '========================================
        If addr = "" Then
        Set UR = Cells(x, y): UR1 = UR.Address(RowAbsolute:=False, ColumnAbsolute:=False)
        For i = 1 To 17: For j = 1 To 30 ' Создать буферный массив для накопления адресов
            s(i, j) = UR1
        Next:  Next
        i = 1: j = 1 ' Начальный указатель в буфере
        End If
      addr = CName(y) & x
      L = Len(addr)
      k = k + L + 1
      If k > 256 Then If j + 1 > 30 Then i = i + 1: j = 1: k = L + 1 Else j = j + 1: k = L + 1 ' При переполнении текущего буфера
      If k = L + 1 Then s(i, j) = addr Else s(i, j) = s(i, j) & "," & addr 'первый без запятой

        If i = 17 And j = 30 Then ' При заполнении буферного массива - Union-страшная функция)))
Остаток:
        Set UR = Union(UR, _
        Union(Range(s(1, 1)), Range(s(1, 2)), Range(s(1, 3)), Range(s(1, 4)), Range(s(1, 5)), Range(s(1, 6)), Range(s(1, 7)), Range(s(1, 8)), Range(s(1, 9)), Range(s(1, 10)), Range(s(1, 11)), Range(s(1, 12)), Range(s(1, 13)), Range(s(1, 14)), Range(s(1, 15)), Range(s(1, 16)), Range(s(1, 17)), Range(s(1, 18)), Range(s(1, 19)), Range(s(1, 20)), Range(s(1, 21)), Range(s(1, 22)), Range(s(1, 23)), Range(s(1, 24)), Range(s(1, 25)), Range(s(1, 26)), Range(s(1, 27)), Range(s(1, 28)), Range(s(1, 29)), Range(s(1, 30))), _
        Union(Range(s(2, 1)), Range(s(2, 2)), Range(s(2, 3)), Range(s(2, 4)), Range(s(2, 5)), Range(s(2, 6)), Range(s(2, 7)), Range(s(2, 8)), Range(s(2, 9)), Range(s(2, 10)), Range(s(2, 11)), Range(s(2, 12)), Range(s(2, 13)), Range(s(2, 14)), Range(s(2, 15)), Range(s(2, 16)), Range(s(2, 17)), Range(s(2, 18)), Range(s(2, 19)), Range(s(2, 20)), Range(s(2, 21)), Range(s(2, 22)), Range(s(2, 23)), Range(s(2, 24)), Range(s(2, 25)), Range(s(2, 26)), Range(s(2, 27)), Range(s(2, 28)), Range(s(2, 29)), Range(s(2, 30))), _
        Union(Range(s(3, 1)), Range(s(3, 2)), Range(s(3, 3)), Range(s(3, 4)), Range(s(3, 5)), Range(s(3, 6)), Range(s(3, 7)), Range(s(3, 8)), Range(s(3, 9)), Range(s(3, 10)), Range(s(3, 11)), Range(s(3, 12)), Range(s(3, 13)), Range(s(3, 14)), Range(s(3, 15)), Range(s(3, 16)), Range(s(3, 17)), Range(s(3, 18)), Range(s(3, 19)), Range(s(3, 20)), Range(s(3, 21)), Range(s(3, 22)), Range(s(3, 23)), Range(s(3, 24)), Range(s(3, 25)), Range(s(3, 26)), Range(s(3, 27)), Range(s(3, 28)), Range(s(3, 29)), Range(s(3, 30))), _
        Union(Range(s(4, 1)), Range(s(4, 2)), Range(s(4, 3)), Range(s(4, 4)), Range(s(4, 5)), Range(s(4, 6)), Range(s(4, 7)), Range(s(4, 8)), Range(s(4, 9)), Range(s(4, 10)), Range(s(4, 11)), Range(s(4, 12)), Range(s(4, 13)), Range(s(4, 14)), Range(s(4, 15)), Range(s(4, 16)), Range(s(4, 17)), Range(s(4, 18)), Range(s(4, 19)), Range(s(4, 20)), Range(s(4, 21)), Range(s(4, 22)), Range(s(4, 23)), Range(s(4, 24)), Range(s(4, 25)), Range(s(4, 26)), Range(s(4, 27)), Range(s(4, 28)), Range(s(4, 29)), Range(s(4, 30))), _
        Union(Range(s(5, 1)), Range(s(5, 2)), Range(s(5, 3)), Range(s(5, 4)), Range(s(5, 5)), Range(s(5, 6)), Range(s(5, 7)), Range(s(5, 8)), Range(s(5, 9)), Range(s(5, 10)), Range(s(5, 11)), Range(s(5, 12)), Range(s(5, 13)), Range(s(5, 14)), Range(s(5, 15)), Range(s(5, 16)), Range(s(5, 17)), Range(s(5, 18)), Range(s(5, 19)), Range(s(5, 20)), Range(s(5, 21)), Range(s(5, 22)), Range(s(5, 23)), Range(s(5, 24)), Range(s(5, 25)), Range(s(5, 26)), Range(s(5, 27)), Range(s(5, 28)), Range(s(5, 29)), Range(s(5, 30))), _
        Union(Range(s(6, 1)), Range(s(6, 2)), Range(s(6, 3)), Range(s(6, 4)), Range(s(6, 5)), Range(s(6, 6)), Range(s(6, 7)), Range(s(6, 8)), Range(s(6, 9)), Range(s(6, 10)), Range(s(6, 11)), Range(s(6, 12)), Range(s(6, 13)), Range(s(6, 14)), Range(s(6, 15)), Range(s(6, 16)), Range(s(6, 17)), Range(s(6, 18)), Range(s(6, 19)), Range(s(6, 20)), Range(s(6, 21)), Range(s(6, 22)), Range(s(6, 23)), Range(s(6, 24)), Range(s(6, 25)), Range(s(6, 26)), Range(s(6, 27)), Range(s(6, 28)), Range(s(6, 29)), Range(s(6, 30))), _
        Union(Range(s(7, 1)), Range(s(7, 2)), Range(s(7, 3)), Range(s(7, 4)), Range(s(7, 5)), Range(s(7, 6)), Range(s(7, 7)), Range(s(7, 8)), Range(s(7, 9)), Range(s(7, 10)), Range(s(7, 11)), Range(s(7, 12)), Range(s(7, 13)), Range(s(7, 14)), Range(s(7, 15)), Range(s(7, 16)), Range(s(7, 17)), Range(s(7, 18)), Range(s(7, 19)), Range(s(7, 20)), Range(s(7, 21)), Range(s(7, 22)), Range(s(7, 23)), Range(s(7, 24)), Range(s(7, 25)), Range(s(7, 26)), Range(s(7, 27)), Range(s(7, 28)), Range(s(7, 29)), Range(s(7, 30))), _
        Union(Range(s(8, 1)), Range(s(8, 2)), Range(s(8, 3)), Range(s(8, 4)), Range(s(8, 5)), Range(s(8, 6)), Range(s(8, 7)), Range(s(8, 8)), Range(s(8, 9)), Range(s(8, 10)), Range(s(8, 11)), Range(s(8, 12)), Range(s(8, 13)), Range(s(8, 14)), Range(s(8, 15)), Range(s(8, 16)), Range(s(8, 17)), Range(s(8, 18)), Range(s(8, 19)), Range(s(8, 20)), Range(s(8, 21)), Range(s(8, 22)), Range(s(8, 23)), Range(s(8, 24)), Range(s(8, 25)), Range(s(8, 26)), Range(s(8, 27)), Range(s(8, 28)), Range(s(8, 29)), Range(s(8, 30))), _
        Union(Range(s(9, 1)), Range(s(9, 2)), Range(s(9, 3)), Range(s(9, 4)), Range(s(9, 5)), Range(s(9, 6)), Range(s(9, 7)), Range(s(9, 8)), Range(s(9, 9)), Range(s(9, 10)), Range(s(9, 11)), Range(s(9, 12)), Range(s(9, 13)), Range(s(9, 14)), Range(s(9, 15)), Range(s(9, 16)), Range(s(9, 17)), Range(s(9, 18)), Range(s(9, 19)), Range(s(9, 20)), Range(s(9, 21)), Range(s(9, 22)), Range(s(9, 23)), Range(s(9, 24)), Range(s(9, 25)), Range(s(9, 26)), Range(s(9, 27)), Range(s(9, 28)), Range(s(9, 29)), Range(s(9, 30))), _
        Union(Range(s(10, 1)), Range(s(10, 2)), Range(s(10, 3)), Range(s(10, 4)), Range(s(10, 5)), Range(s(10, 6)), Range(s(10, 7)), Range(s(10, 8)), Range(s(10, 9)), Range(s(10, 10)), Range(s(10, 11)), Range(s(10, 12)), Range(s(10, 13)), Range(s(10, 14)), Range(s(10, 15)), Range(s(10, 16)), Range(s(10, 17)), Range(s(10, 18)), Range(s(10, 19)), Range(s(10, 20)), Range(s(10, 21)), Range(s(10, 22)), Range(s(10, 23)), Range(s(10, 24)), Range(s(10, 25)), Range(s(10, 26)), Range(s(10, 27)), Range(s(10, 28)), Range(s(10, 29)), Range(s(10, 30))), _
        Union(Range(s(11, 1)), Range(s(11, 2)), Range(s(11, 3)), Range(s(11, 4)), Range(s(11, 5)), Range(s(11, 6)), Range(s(11, 7)), Range(s(11, 8)), Range(s(11, 9)), Range(s(11, 10)), Range(s(11, 11)), Range(s(11, 12)), Range(s(11, 13)), Range(s(11, 14)), Range(s(11, 15)), Range(s(11, 16)), Range(s(11, 17)), Range(s(11, 18)), Range(s(11, 19)), Range(s(11, 20)), Range(s(11, 21)), Range(s(11, 22)), Range(s(11, 23)), Range(s(11, 24)), Range(s(11, 25)), Range(s(11, 26)), Range(s(11, 27)), Range(s(11, 28)), Range(s(11, 29)), Range(s(11, 30))), _
        Union(Range(s(12, 1)), Range(s(12, 2)), Range(s(12, 3)), Range(s(12, 4)), Range(s(12, 5)), Range(s(12, 6)), Range(s(12, 7)), Range(s(12, 8)), Range(s(12, 9)), Range(s(12, 10)), Range(s(12, 11)), Range(s(12, 12)), Range(s(12, 13)), Range(s(12, 14)), Range(s(12, 15)), Range(s(12, 16)), Range(s(12, 17)), Range(s(12, 18)), Range(s(12, 19)), Range(s(12, 20)), Range(s(12, 21)), Range(s(12, 22)), Range(s(12, 23)), Range(s(12, 24)), Range(s(12, 25)), Range(s(12, 26)), Range(s(12, 27)), Range(s(12, 28)), Range(s(12, 29)), Range(s(12, 30))), _
        Union(Range(s(13, 1)), Range(s(13, 2)), Range(s(13, 3)), Range(s(13, 4)), Range(s(13, 5)), Range(s(13, 6)), Range(s(13, 7)), Range(s(13, 8)), Range(s(13, 9)), Range(s(13, 10)), Range(s(13, 11)), Range(s(13, 12)), Range(s(13, 13)), Range(s(13, 14)), Range(s(13, 15)), Range(s(13, 16)), Range(s(13, 17)), Range(s(13, 18)), Range(s(13, 19)), Range(s(13, 20)), Range(s(13, 21)), Range(s(13, 22)), Range(s(13, 23)), Range(s(13, 24)), Range(s(13, 25)), Range(s(13, 26)), Range(s(13, 27)), Range(s(13, 28)), Range(s(13, 29)), Range(s(13, 30))), _
        Union(Range(s(14, 1)), Range(s(14, 2)), Range(s(14, 3)), Range(s(14, 4)), Range(s(14, 5)), Range(s(14, 6)), Range(s(14, 7)), Range(s(14, 8)), Range(s(14, 9)), Range(s(14, 10)), Range(s(14, 11)), Range(s(14, 12)), Range(s(14, 13)), Range(s(14, 14)), Range(s(14, 15)), Range(s(14, 16)), Range(s(14, 17)), Range(s(14, 18)), Range(s(14, 19)), Range(s(14, 20)), Range(s(14, 21)), Range(s(14, 22)), Range(s(14, 23)), Range(s(14, 24)), Range(s(14, 25)), Range(s(14, 26)), Range(s(14, 27)), Range(s(14, 28)), Range(s(14, 29)), Range(s(14, 30))), _
        Union(Range(s(15, 1)), Range(s(15, 2)), Range(s(15, 3)), Range(s(15, 4)), Range(s(15, 5)), Range(s(15, 6)), Range(s(15, 7)), Range(s(15, 8)), Range(s(15, 9)), Range(s(15, 10)), Range(s(15, 11)), Range(s(15, 12)), Range(s(15, 13)), Range(s(15, 14)), Range(s(15, 15)), Range(s(15, 16)), Range(s(15, 17)), Range(s(15, 18)), Range(s(15, 19)), Range(s(15, 20)), Range(s(15, 21)), Range(s(15, 22)), Range(s(15, 23)), Range(s(15, 24)), Range(s(15, 25)), Range(s(15, 26)), Range(s(15, 27)), Range(s(15, 28)), Range(s(15, 29)), Range(s(15, 30))), _
        Union(Range(s(16, 1)), Range(s(16, 2)), Range(s(16, 3)), Range(s(16, 4)), Range(s(16, 5)), Range(s(16, 6)), Range(s(16, 7)), Range(s(16, 8)), Range(s(16, 9)), Range(s(16, 10)), Range(s(16, 11)), Range(s(16, 12)), Range(s(16, 13)), Range(s(16, 14)), Range(s(16, 15)), Range(s(16, 16)), Range(s(16, 17)), Range(s(16, 18)), Range(s(16, 19)), Range(s(16, 20)), Range(s(16, 21)), Range(s(16, 22)), Range(s(16, 23)), Range(s(16, 24)), Range(s(16, 25)), Range(s(16, 26)), Range(s(16, 27)), Range(s(16, 28)), Range(s(16, 29)), Range(s(16, 30))), _
        Union(Range(s(17, 1)), Range(s(17, 2)), Range(s(17, 3)), Range(s(17, 4)), Range(s(17, 5)), Range(s(17, 6)), Range(s(17, 7)), Range(s(17, 8)), Range(s(17, 9)), Range(s(17, 10)), Range(s(17, 11)), Range(s(17, 12)), Range(s(17, 13)), Range(s(17, 14)), Range(s(17, 15)), Range(s(17, 16)), Range(s(17, 17)), Range(s(17, 18)), Range(s(17, 19)), Range(s(17, 20)), Range(s(17, 21)), Range(s(17, 22)), Range(s(17, 23)), Range(s(17, 24)), Range(s(17, 25)), Range(s(17, 26)), Range(s(17, 27)), Range(s(17, 28)), Range(s(17, 29)), Range(s(17, 30))))
          
        For i = 1 To 17: For j = 1 To 30 ' очистить буферный массив для накопления адресов
        s(i, j) = UR1
        Next:  Next
        i = 1: j = 1: k = 0 ' Начальный указатель в буфере
        End If
      End If
    Next
  Next
  If k > 0 Then GoTo Остаток
  If Not IsEmpty(UR) Then UR.Select
  
Set UR = Nothing: Set aa = Nothing
With Application: .ScreenUpdating = True: .DisplayAlerts = True: .EnableEvents = True: .Calculation = ac: End With

Debug.Print Timer - t: Debug.Print Selection.Count
End Sub

Sub заполнить_лист()
    Dim i&, j&, t#, a&(1 To 10000, 1 To 25)
    t = Timer
    For i = 1 To 10000
        For j = 1 To 25
            a(i, j) = Int(Rnd * 2000)
        Next
    Next
    [a1].Resize(10000, 25) = a
    Debug.Print Timer - t
End Sub

что-то мне подсказывает, что сразу использовать твои "наработки" в своих проектах не получиться (один Union Union'ов чего стоит) - всё равно надо писать функции и процедуры — у меня всё уже написано и это ДАЛЕКО не тоже самое, что у тебя (вообще подходы похожи только понимаем того, что Union нужно забивать под завязку), не говоря уже про шуструю "резку строк" (у тебя строка адреса "заполняется под завязку" в процессе отбора, что неудобно для работы с другими процедурами)

Цитата
БМВ: И пришел медведь

и пустил по миру очередную тему

А если серьёзно — где твой "карандаш"? Наверное предложишь глазками искать, да ручками выделять

Я уже 3ю тему жду, а ты до сих пор не можешь понять, зачем собирать адреса и никаких альтернатив не предлагаешь…

Цитата
БМВ: Во время разработки космической программы

очередная байка пропаганды о том, какие мы умные, а пиндосы тупые — разумеется, фейк (1, 2)

Изменено: Jack Famous - 10.03.2021 14:08:56

БМВ

Модератор

Сообщений: 23300 Регистрация: 28.12.2016

Excel 2013, 2016

10.03.2021 11:36:38

Я не могу предложить альтернативное решение применение которого мне не понятно. Я ж писал на полном серьезе. Метод ради метода - не поддерживаю. С областью по крайним точкам в первой теме разобрались - простое решение. Даже если оно окажется медленным, то предпочту 4 строки. Леш приведи пример реального использования на примере 2-3 областей. Заметь, я не критикую само решение, я применимость к чему либо невкуриваю.

Изменено: БМВ - 10.03.2021 11:37:03

По вопросам из тем форума, личку не читаю.

bedvit

Пользователь

Сообщений: 2629 Регистрация: 02.04.2015

Виталий

10.03.2021 11:39:35

Мда... в моих 76 строках не разобраться, зато в твоих 192 строках - все понятно

Цитата
Jack Famous написал: подходы похожи

это потому, что ты сделал свой подход на основании моего (только еще парсинг строки добавил.), а я свой сделал на основании алгоритма от ZVI. Не разобрал как тестировать твой код, думаю и по скорости из-за парсинга прогрывает.

Изменено: bedvit - 10.03.2021 11:40:30

«Бритва Оккама» или «Принцип Калашникова»?

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

10.03.2021 11:54:27

Цитата
БМВ: Я не могу предложить альтернативное решение применение которого мне не понятно

и что же тебе непонятно в этом примере "закрасить ячейки с двоечками"?

Цитата
БМВ: Даже если оно окажется медленным, то предпочту 4 строки

о - ну так у нас тогда разные задачи, т.к. я VBA деньги зарабатываю и все мои инструменты должны быть максимально быстрыми (особенно, если брать разницу в десятки-сотни раз, как тут)

Цитата
bedvit: ты сделал свой подход на основании моего

это просто смешно — я взял оттуда только забивку Union под завязку и, заметь, совершенно другая функция, то есть "взял" по факту просто понимание того, что Union нужно применять с 30ю диапазонами, потому что он медленный. Без твоего кода, сделал бы это "открытие" несколькими минутами/часами позднее при тестировании, т.к. и так было понятно, кто "тормоз"

Цитата
bedvit: думаю и по скорости из-за парсинга прогрывает

время "парсинга" собранных адресов с распилом на блоки и получением диапазонов составляет 0,02 секунды на 25 тысячах отдельных ячеек/адресов. Время сбора адресов должно быть меньше твоего, т.к. у тебя дополнительные проверки на длину стэка. То есть при +- одинаковом времени сбора, я трачу ЦЕЛЫХ ДВЕ СОТЫХ секунды на то, чтобы превратить переданный массив адресов в диапазоны максимально длинных адресов

Повторюсь, используя данный подход, я могу из любой процедуры насобирать массивы по критериям и ПРОСТО ПЕРЕДАТЬ ИХ, безо всяких контролей стэков и прочего

Изменено: Jack Famous - 10.03.2021 11:57:49

bedvit Пользователь Сообщений: 2629 Регистрация: 02.04.2015 Виталий	#8 10.03.2021 11:57:30 Это все слова, в моем алгоритме, по ссылке (см.выше) от 2016 года, обработка 250 тыс. ячеек с выделением 60 тыс.-5сек. Какое у тебя время? Прикладывай пример, померяемся.... «Бритва Оккама» или «Принцип Калашникова»?

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

10.03.2021 12:03:14

Цитата
bedvit: Прикладывай пример, померяемся

у тебя вылизанный код для одной единственной задачи, а у меня 3 функции для применения в любых условиях (на входе одномерный массив адресов, на выходе 1 диапазон) — и какой смысл в сравнении?
Ради интереса можно, конечно - сколько времени у тебя займёт получение диапазона (объект Range) из 25 тыс ячеек примера (каждая 4я ячейка, из диапазона "A2:A100000")?

bedvit Пользователь Сообщений: 2629 Регистрация: 02.04.2015 Виталий	#10 10.03.2021 12:04:16 Понятно, твой код медленнее, кол-во строк в 2 раза больше... я пошел..) «Бритва Оккама» или «Принцип Калашникова»?

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#11

10.03.2021 12:13:15

Цитата
bedvit: твой код медленнее

безосновательное суждение - я сделаю пример сам, раз ты так переживаешь

Цитата
bedvit: кол-во строк в 2 раза больш

Код

      If k > 256 Then If j + 1 > 30 Then i = i + 1: j = 1: k = L + 1 Else j = j + 1: k = L + 1 ' При переполнении текущего буфера
      If k = L + 1 Then s(i, j) = addr Else s(i, j) = s(i, j) & "," & addr 'первый без запятой

а чего ты вообще весь код в 1 строку не засунул - всех бы победил навсегда

bedvit

Пользователь

Сообщений: 2629 Регистрация: 02.04.2015

Виталий

#12

10.03.2021 12:19:39

Тестовый стенд есть в той теме, которую я скинул выше.
Вот он

Код

Sub заполнить_лист()
    Dim i&, j&, t#, a&(1 To 10000, 1 To 25)
    t = Timer
    For i = 1 To 10000
        For j = 1 To 25
            a(i, j) = Int(Rnd * 2000)
        Next
    Next
    [a1].Resize(10000, 25) = a
    Debug.Print Timer - t
End Sub

Задача: выделить в полученном стенде - вся ячейки , значением более 1500

«Бритва Оккама» или «Принцип Калашникова»?

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#13

10.03.2021 12:44:46

bedvit, хорошие новости - ты выиграл 0,1 сек (спишу для себя на вывод Debug'ов)

лол

Скрины

обновил СС

Отдельно прошу обратить внимание, насколько маленькая мне понадобилась процедура для теста (фактически, преобразование массива адресов в 1 диапазон занимает всего 1 строку) — всё делают функции, просто передай им адреса

Вот так стараешься-стараешься, а потом гораздо более удобный универсальный код твоему не проигрывает

Изменено: Jack Famous - 10.03.2021 12:54:37

bedvit

Пользователь

Сообщений: 2629 Регистрация: 02.04.2015

Виталий

#14

10.03.2021 12:54:06

Цитата
Jack Famous написал: ты выиграл 0,1 сек

Вопрос-то не в том, что я выиграл на 0,1 сек., я это и ранее знал, что будет быстрее. Вопрос в том, что еще 4 марта, в твоей первой теме я тебе сказал, что парсить строку более 255 символов, дольше, чем сразу обрабатывать. Вот ответ к твоей первой теме (можно было там и продолжить, а не делать 3 штуки).

«Бритва Оккама» или «Принцип Калашникова»?

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#15

10.03.2021 12:59:16

Цитата
bedvit: Вопрос в том, что еще 4 марта, в твоей первой теме я тебе сказал, что парсить строку более 255 символов, дольше, чем сразу обрабатывать

не мешки ворочать, как говориться - никаких сравнений ты не делал, да и сейчас это пустые слова, т.к. макрос состоит не только из сбора адресов с распилом — с одной стороны и сбора строк с контролем длины каждой — в другом. Нет так ли?
Там ты сказал, что это бред, однако разницы с твоим "комбайном" по скорости по сути НЕТ. Ты даже стесняешься это признать, т.к. не ожидал - не так ли?)))

Можно проверить вчистую, но теперь давай-ка уже сам - сам палец о палец не ударил. Мне в любом случае, контроль каждой строки при сборе — не нужен, потому что это неудобно. Если даже ты прав и вся разница в скорости это проигрыш "распила", то я готов "подождать" 0,1 сек в пользу гораздо большего удобства работы

Как бы тебе пришлось поменять своего монстрилу, чтобы "влезть" в мой пример? А в другой? То-то же — у меня это заняло пару минут

Изменено: Jack Famous - 10.03.2021 13:03:24

bedvit

Пользователь

Сообщений: 2629 Регистрация: 02.04.2015

Виталий

#16

10.03.2021 13:10:07

Цитата
Jack Famous написал: никаких сравнений ты не делал

Цитата
Jack Famous написал: сам палец о палец не ударил

Цитата
Jack Famous написал: Если даже ты прав и вся разница в скорости это проигрыш "распила",

зачем этот распил, если можно сделать сразу всё, как нужно?
"Ёжики кололись и плакали, но продолжали жрать кактус..." Ладно, я пойду....

«Бритва Оккама» или «Принцип Калашникова»?

БМВ

Модератор

Сообщений: 23300 Регистрация: 28.12.2016

Excel 2013, 2016

#17

10.03.2021 14:54:25

Fill data: 113 ms
Prepare: 66 ms
Get Address: 78 ms
AdrToBl: 31 ms
BlToRng: 2066 ms
Paint: 55 ms
Total time: 2434 ms

Скрытый текст

Fill data: 98 ms
Prepare: 39 ms
Paint: 449 ms
Total time: 555 ms

По вопросам из тем форума, личку не читаю.

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#18

10.03.2021 15:10:09

БМВ, больше удивлён, что через расширенный делал, а не через обычный

Что насчёт отбора по данным Витали или нескольких групп диапазонов по типу ColorMap или отбора значений по условию больше/меньше, по маске? Как сработает там? Если искать в умных таблицах?
Для наших с Виталей вариантов это не проблема, а вот расширенный фильтр, думаю, тут не поможет
Я бы сказал, что вариант отличный, но только для конкретного примера — не очень универсальный способ, зато, безусловно, быстрый (тут вопросов нет — добавлю в СС)

Уделывает (0,3 сек у дядь Миши против 2 у меня на 25 тыс выбранных)

Изменено: Jack Famous - 10.03.2021 15:33:38

БМВ

Модератор

Сообщений: 23300 Регистрация: 28.12.2016

Excel 2013, 2016

#19

10.03.2021 15:52:20

Алексей, в борьбе за универсальность мы получаем продукты раздутые и не оптимальные. Говноприложение на телефоне занимающее 100мб - это норма... зачем оптимизировать, лучше сказать что нужен телефон с большим объемом памяти .,....

Расширенный - да просто чтоб автофильтр не включать и не отключать :-). Да и делал то только для того чтоб показать что цель достигается другими средствами, хотя всегда может оказаться что фильтр установлен пользователем и решение его сбросит......

По вопросам из тем форума, личку не читаю.

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#20

10.03.2021 15:55:26

Цитата
БМВ: зачем оптимизировать, лучше сказать что нужен телефон с большим объемом памяти

а ты с другой стороны посмотри — зачем "усираться" (платить более крутому программеру, например, или тратить больше времени) в борьбе за уменьшение размера на 20, скажем Мб (1/5 от общего размера твоего примера), если 1 фотка на современном телефоне "весит" 5 Мб??? Я, например, понимаю, разрабов: нет нескольких мегабайт на обновление, так используй старые приложения или не используй вообще и считай на калькуляторе - так и энергию сэкономишь

Цитата
БМВ: цель достигается другими средствами

ненадёжно, а это тоже очень важно. В любом случае в тему (наконец-то) и лишним не будет, так что спасибо

Изменено: Jack Famous - 10.03.2021 16:04:09

БМВ

Модератор

Сообщений: 23300 Регистрация: 28.12.2016

Excel 2013, 2016

#21

10.03.2021 15:56:26

Цитата
Jack Famous написал: (наконец-то)

ты показал зачем это :-)

По вопросам из тем форума, личку не читаю.

Дмитрий(The_Prist) Щербаков

Пользователь

Сообщений: 14895 Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#22

10.03.2021 15:57:30

Цитата
БМВ написал: Расширенный - да просто чтоб автофильтр не включать и не отключать

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

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...

БМВ

Модератор

Сообщений: 23300 Регистрация: 28.12.2016

Excel 2013, 2016

#23

10.03.2021 16:02:26

Цитата
Дмитрий(The_Prist) Щербаков написал: не скажи.

Дмитрий, это для конкретного случая. я было хотел сперва в F2 загнать =R2С1=2 и оставить пустым F1 но потом оставил как есть. А так - инструмент очень мощьный.

По вопросам из тем форума, личку не читаю.

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#24

10.03.2021 16:03:50

Цитата
Дмитрий(The_Prist) Щербаков: есть и более грубокий смысл.

он ещё и строки длиннее 255 символов фильтрует - я его как раз для этого в основном использую. Насчёт дат, времени и прочего - действительно намного проще, чем штатный вот только "посмотреть" фильтр в отличие от штатного нельзя. Если бы не этот минус, то про штатный в VBA бы забыл
Но это всё оффтоп - что насчёт использования его для отбора в диапазоне нескольких столбцов без шапки, как в примере у Витали?

БМВ

Модератор

Сообщений: 23300 Регистрация: 28.12.2016

Excel 2013, 2016

#25

10.03.2021 16:45:03

Цитата
Jack Famous написал: без шапки,

вставить пустую строку и использовать формульный вариант расширенного.

Цитата
Jack Famous написал: как в примере у Витали

это где?

По вопросам из тем форума, личку не читаю.

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#26

10.03.2021 16:56:21

Собрал стэнд для теста «стэка» против «резки»

Код

Option Explicit
'====================================================================================================
Dim arrAdr(), fArr As Boolean
'====================================================================================================
Sub Tester()
Dim rng As Range
Dim adr$, t!, a&, r&, c&

fArr = True
'fArr = False

t = Timer
TestByBedVit

    If fArr Then
        Set rng = ArrayUnion(arrAdr)
    Else
        Set rng = AddressToRange(shBedVit, Join(arrAdr, ","))
    End If

Debug.Print Format$(1000 * (Timer - t), "0 ms"), rng.Count
End Sub

' Count:        62 402  cells

' MyStack:      6.8     sec
' BedVit:       6.95    sec
' MyAddress:    7       sec
'====================================================================================================
Sub TestByBedVit()
Dim rng As Range
Dim x, arr, tmp() As String
Dim adr$, a&, r&, c&, i&, l&, ll&, flag As Boolean

Set rng = shBedVit.Range("A1:Y10000")
arr = rng.Value: a = -1: i = -1
r = UBound(arr, 1) * UBound(arr, 2)

    If fArr Then
        ReDim tmp(99)
        ReDim arrAdr(r \ 10)
    Else
        ReDim arrAdr(r - 1)
    End If

    For c = 1 To UBound(arr, 2)
        For r = 1 To UBound(arr, 1)
            If arr(r, c) > 1500 Then
                adr = rng(r, c).Address(0, 0)

                If fArr Then
                    l = Len(adr) + 1
                    ll = ll + l

                    If ll > 253 Then            ' если в стэке строка длиннее 253 символов (с запятыми)
                        If ll < 257 Then        ' если получается строка длиной 254, 255 или 256 символов, то текущий адрес является последним для стэка
                            flag = True
                            i = i + 1: tmp(i) = adr
                        End If

                        ReDim Preserve tmp(i)
                        a = a + 1: Set arrAdr(a) = shBedVit.Range(Join(tmp, ","))
                        ReDim tmp(99)

                        If flag Then            ' если флаг был выставлен, то текущий адреc влез, иначе поместить первым в новый стэк
                            flag = False: i = -1: ll = 0
                        Else
                            i = 0: tmp(0) = adr: ll = l
                        End If
                    Else
                        i = i + 1: tmp(i) = adr
                    End If
                Else
                    a = a + 1: arrAdr(a) = adr
                End If
            End If
        Next r
    Next c

    If i <> -1 Then ' если в стэке что-то осталось, то добавляем
        ReDim Preserve tmp(i)
        a = a + 1: Set arrAdr(a) = shBedVit.Range(Join(tmp, ","))
    End If

ReDim Preserve arrAdr(a)
End Sub
'====================================================================================================

мой вариант чуть быстрее (0,15 сек при том, что это не 1 макрос, а передача параметров), чем у bedvit'а, но всё равно в пределах погрешности
Чуда не случилось - коль значимого выигрыша стэк (компоновка максимально длинных для создания адреса строк) не даёт, а проблем и неудобств больше (во всяком случае — для меня)

Выводы:
• Повторюсь (bedvit также на это указывает), что резка одной огромной строки или компоновка в цикле (без разницы) — это всё ~ 1% от всего времени работы, а значит нет смысла что-то докручивать в этой части алгоритма. Основное время съедает Union — надо что-то ещё покрутить с ним…
• Расширенный фильтр
Есть сомнения, что лидерство сохранится при увеличении количества отобранных диапазонов и/или столбцов для поиска
В любом случае, специфика работы этого инструмента не позволяет его использовать настолько же свободно, как решения, не привязанные к инструментам Excel

Изменено: Jack Famous - 10.03.2021 17:03:38

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#27

10.03.2021 17:08:19

Цитата
БМВ: это где?

в СС - было, но обновил, добавив твой вариант и стэк

Цитата
БМВ: вставить пустую строку и использовать формульный вариант расширенного.

а остальное? Фильтр по нескольким столбцам попробуй, пожалуйста …

Изменено: Jack Famous - 10.03.2021 17:09:19

bedvit

Пользователь

Сообщений: 2629 Регистрация: 02.04.2015

Виталий

#28

10.03.2021 17:36:57

Однажды Лебедь, Рак да Щука
Везти с поклажей воз взялись,
И вместе трое все в него впряглись;
Из кожи лезут вон, а возу всё нет ходу!
Поклажа бы для них казалась и легка:
Да Лебедь рвется в облака,
Рак пятится назад, а Щука тянет в воду.
Кто виноват из них, кто прав, – судить не нам;
Да только воз и ныне там

«Бритва Оккама» или «Принцип Калашникова»?

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#29

10.03.2021 17:39:12

Цитата
bedvit: Да только воз и ныне там

ничего подобного — воз по всей поляне летает, припарковать не можем

bedvit Пользователь Сообщений: 2629 Регистрация: 02.04.2015 Виталий	#30 10.03.2021 17:44:05 Летает, а толку нет. Все осталось на уровне темы 2016 года. «Бритва Оккама» или «Принцип Калашникова»?