Excel Name.RefersToRange: как проверить, ссылается ли объект Name на диапазон?
Документация Microsoft говорит о RefersToRange:
Если объект Name не ссылается на диапазон (например, если он ссылается на константу или формулу), это свойство не выполняется.
Я пытаюсь перебрать все именованные диапазоны на листе.
Private Sub Something()
Dim namedRanges As names
Set namedRanges = ActiveSheet.names
Dim targetSheet As Worksheet
Set targetSheet = Sheet1
targetSheet.Cells.Clear
Dim i As Integer
For i = 1 To namedRanges.count
targetSheet.Cells(i, 2).Value = namedRanges(i).Name
targetSheet.Cells(i, 3).Value = namedRanges(i).RefersToRange.Address
Next
End Sub
Выше мой код не будет работать, если какой-либо NamedRange не ссылается на диапазон. Как я могу проверить, относится ли объект Name к диапазону, чтобы мой код не ошибался?
ОБНОВИТЬ
Я нашел хак для этого, но предпочел бы более чистый способ. Я проверяю, содержит ли строковое значение именованного диапазона знак доллара, который косвенно говорит мне, содержит ли он значение адреса (которое будет иметь диапазон):
For i = 1 To namedRanges.count
targetSheet.Cells(i, 2).Value = namedRanges(i).Name
If InStr(namedRanges(i).Value, "$") > 0 Then
targetSheet.Cells(i, 3).Value = namedRanges(i).RefersToRange.Address
End If
Next
2 ответа
Примерно так, который проверяет, есть ли допустимое пересечение в используемом диапазоне листа интереса с вашим именем диапазона
Предостережение: это предполагает, что ваш используемый диапазон действительно охватывает ваши потенциальные имена диапазонов. Что я считаю безопасным предположением
Кроме того, вы, я не думаю, что вы можете работать с ActiveSheet.Names
так, как вы пытались.
Private Sub Something()
Dim nmRng As Name
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Sheets(1).UsedRange
On Error Resume Next
For Each nmRng In ActiveWorkbook.Names
Set rng2 = Nothing
Set rng2 = Intersect(rng1, Range(nmRng))
If Not rng2 Is Nothing Then Debug.Print nmRng & " " & nmRng.RefersTo.Address
Next
On Error GoTo 0
End Sub
РЕДАКТИРОВАТЬ: я изменил обработку ошибок, чтобы опустить константы Не то, чтобы я защищал этот подход для большинства проблем, но вы могли бы использовать
on error goto "label"
который будет выглядеть примерно так
Private Sub Something()
Dim namedRanges As names
Set namedRanges = ActiveSheet.names
Dim targetSheet As Worksheet
Set targetSheet = Sheet1
targetSheet.Cells.Clear
Dim i As Integer
'skip the errors
on error goto skipName
'set start of data range
Row = 2
For i = 1 To namedRanges.count
targetSheet.Cells(Row, 3).Value = namedRanges(i).RefersToRange.Address
targetSheet.Cells(Row, 2).Value = namedRanges(i).Name
Row = Row + 1
skipName:
Next
'reinstate normal error trapping
on error goto 0
End Sub
Обработка ошибок теперь будет пропускать перечисление имен при сбое Referstorange.