3

Документация 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 ответа2

1

Примерно так, который проверяет, есть ли допустимое пересечение в используемом диапазоне интересующего вас листа с вашим именем диапазона

Предостережение: Это предполагает, что ваш используемый диапазон действительно охватывает ваши потенциальные имена диапазонов. Что я считаю безопасным предположением

Также вы, я не думаю, что вы можете работать с 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
1

РЕДАКТИРОВАТЬ: я изменил обработку ошибок, чтобы опустить константы Не то, чтобы я защищал этот подход для большинства проблем, но вы могли бы использовать

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.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .