Приветствую! Похожее было, например, тут. Оттуда же и функция ZVI (слегка изменённая)
Смотреть концевик темы — есть важные обновления!
Итак, метод определения наличия имени, предложенный ZVI прекрасен в своей простоте и скорости. У него конкурентов нет
Популярный метод определения, является (может ли стать) текстовая переменная диапазоном (с помощью Evaluate), медленнее аналога на Range от 2ух до 9ти раз. Обращаю внимание, что Имя (именованный диапазон) ПРОХОДИТ проверку на Диапазон, но ДиапазонНЕ ПРОХОДИТ проверку на Имя.
Option Base 1
Option Explicit
Option Private Module
'====================================================================================================
Sub TestNames()
Dim rng As Range
Dim tx$, t!, n&, f As Boolean
Const cyc& = 1000000
tx = "a1"
t = Timer
For n = 1 To cyc
f = IsName(tx)
Next n
Debug.Print Format$(Timer - t, "0.00"), f, tx ' 2.83, False
tx = "_testName"
t = Timer
For n = 1 To cyc
f = IsName(tx)
Next n
Debug.Print Format$(Timer - t, "0.00"), f, tx ' 1.41, True
tx = "tx"
t = Timer
For n = 1 To cyc
f = IsName(tx)
Next n
Debug.Print Format$(Timer - t, "0.00"), f, tx ' 2.8, False
End Sub
'====================================================================================================
'by ZVI: https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=25359
'====================================================================================================
Function IsName(txName$) As Boolean
On Error Resume Next
With Names(txName): End With
IsName = (Err.Number = 0)
On Error GoTo 0
End Function
'====================================================================================================
CheckRange
Код
Option Base 1
Option Explicit
Option Private Module
'====================================================================================================
Sub TestRanges()
Dim rng As Range
Dim tx$, t!, n&, f As Boolean
Const cyc& = 10000
tx = "a1"
t = Timer
For n = 1 To cyc
f = IsRange_Evaluate(tx)
Next n
Debug.Print Format$(Timer - t, "0.00"), f, "IsRange_Evaluate", tx ' 0.30
t = Timer
For n = 1 To cyc
f = IsRange_Range(tx)
Next n
Debug.Print Format$(Timer - t, "0.00"), f, "IsRange_Range", tx ' 0.03
tx = "a1:a2,c8:c100"
t = Timer
For n = 1 To cyc
f = IsRange_Evaluate(tx)
Next n
Debug.Print Format$(Timer - t, "0.00"), f, "IsRange_Evaluate", tx ' 0.30
t = Timer
For n = 1 To cyc
f = IsRange_Range(tx)
Next n
Debug.Print Format$(Timer - t, "0.00"), f, "IsRange_Range", tx ' 0.05
tx = "_testName"
t = Timer
For n = 1 To cyc
f = IsRange_Evaluate(tx)
Next n
Debug.Print Format$(Timer - t, "0.00"), f, "IsRange_Evaluate", tx ' 0.27
t = Timer
For n = 1 To cyc
f = IsRange_Range(tx)
Next n
Debug.Print Format$(Timer - t, "0.00"), f, "IsRange_Range", tx ' 0.05
tx = "tx"
t = Timer
For n = 1 To cyc
f = IsRange_Evaluate(tx)
Next n
Debug.Print Format$(Timer - t, "0.00"), f, "IsRange_Evaluate", tx ' 3.18
t = Timer
For n = 1 To cyc
f = IsRange_Range(tx)
Next n
Debug.Print Format$(Timer - t, "0.00"), f, "IsRange_Range", tx ' 1.44
End Sub
'====================================================================================================
'====================================================================================================
Function IsRange_Evaluate(txRng$) As Boolean
IsRange_Evaluate = TypeOf Evaluate(txRng) Is Range
End Function
'====================================================================================================
Function IsRange_Range(txRng$) As Boolean
On Error Resume Next
IsRange_Range = TypeOf Range(txRng) Is Range
On Error GoTo 0
End Function
'====================================================================================================
'====================================================================================================
Выводы: • Evaluate в разы медленнее Range (даже с перещёлкиванием обхода ошибок туда-сюда в цикле), так что подменять им Range в цикле — плохая идея • проверка "корректного" текста диапазона около 10 раз быстрее проверки НЕкорректного • проверки "корректного" имени и "некорректного" примерно равны по скорости между собой и с [быстрой] проверкой "корректного" диапазона. Это означает, что для проверки ИМЕНИ не нужно предварительно проверять текст на ДИАПАЗОН — будет в разы (до 10ти раз) дольше.
UPD 22/11/2022: Конструкция TypeOf Expression Is Value является самым производительным вариантом. Работает для определения: • листа: f = TypeOf Workbooks().Sheets(txShName) Is Worksheet • диапазона: f = TypeOf Workbooks().Sheets().Range(txAddress) Is Range • имени: f = TypeOf Workbooks().Names(txName) Is Name
Коды функций
Код
'==================================================================================================
Function PRDX_Sheet_Exists(WB As Workbook, shName$, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
On Error Resume Next
PRDX_Sheet_Exists = TypeOf WB.Sheets(shName) Is Worksheet
On Error GoTo 0
If PRDX_Sheet_Exists Then If MsgTrue Then MsgBox "WorkBook «" & WB.Name & "» CONTAINS the Sheet «" & shName, vbExclamation, "PRDX_Sheet_Exists": Exit Function Else Exit Function
If MsgFalse Then MsgBox "WorkBook «" & WB.Name & "» DOESN't CONTAIN the Sheet «" & shName, vbExclamation, "PRDX_Sheet_Exists"
End Function
'==================================================================================================
Function PRDX_Rng_Exists(sh As Worksheet, txRng$, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
On Error Resume Next
PRDX_Rng_Exists = TypeOf sh.Range(txRng) Is Range
On Error GoTo 0
If PRDX_Rng_Exists Then If MsgTrue Then MsgBox "Range «" & txRng & "» is Exists in a Book!", vbExclamation, "PRDX_Rng_Exists": Exit Function Else Exit Function
If MsgFalse Then MsgBox "Range «" & txRng & "» is NOT Exists in a Book!", vbCritical, "PRDX_Rng_Exists"
End Function
'==================================================================================================
Function PRDX_Name_Exists(WB As Workbook, txName$, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
On Error Resume Next
PRDX_Name_Exists = TypeOf WB.Names(txName) Is Name
On Error GoTo 0
If PRDX_Name_Exists Then If MsgTrue Then MsgBox "Name «" & txName & "» is already Exists!", vbExclamation, "PRDX_Name_Exists": Exit Function Else Exit Function
If MsgFalse Then MsgBox "Name «" & txName & "» is NOT Exists!", vbCritical, "PRDX_Name_Exists"
End Function
'==================================================================================================
Тесты не правил.
Изменено: - 22.11.2022 14:01:31
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел)
