В VBA, как перечислить именованные записи диапазона в соответствии с их положением на листе

Question

Я назвал диапазоны, расположенные один под другим на листе.

В событии инициализации пользовательской формы (которое содержит список) я добавляю записи в список, когда каждая запись является именем одного именованного диапазона.

К настоящему времени мне удалось загрузить список с записями в соответствии с алфавитным порядком именованных диапазонов, поэтому имена, начинающиеся с 'a', находятся вверху списка, а 'z' - внизу.

Я хочу, чтобы записи были в том порядке, в котором они отображаются на листе, поэтому именованный диапазон, расположенный ближе к A1, будет отображаться в верхней части списка, а именованный диапазон в A1 будет второй записью и т. Д. До последний именованный диапазон на листе (внизу листа), который, конечно, будет последней записью.

Кто-нибудь может найти элегантный способ сделать это?

Answer 1

Попробуйте это:

Private Sub UserForm_Initialize()
    Dim rCell As Range
    Dim nLoop As Name

    With CreateObject("scripting.dictionary")
        For Each rCell In ActiveSheet.UsedRange.Resize(, 1).Cells
            For Each nLoop In ThisWorkbook.Names
                If Not Intersect(Range(nLoop.RefersTo), Range(rCell.Address)) Is Nothing Then
                    If Not .Exists(nLoop.Name) Then
                        Me.ListBox1.AddItem nLoop.Name
                        .Add (nLoop.Name), Nothing
                        Exit For
                    End If
                End If
            Next
        Next rCell
    End With

End Sub

Answer 2

Я не уверен, что это элегантное решение, но это простое решение.

В приведенном ниже коде предполагается, что имена диапазонов находятся в ячейках A1, A2, A3 и т. Д. Sheet2 и чтосписок заканчивается пустой ячейкой.Предполагается также, что в столбцах B, C и т. Д. Ничего не нужно. Вам придется корректировать код для реальной ситуации.

Sub GetNameDetails()

  Dim Inx As Integer
  Dim NameCrnt As String
  Dim Pos As Integer
  Dim RangeCrnt As String
  Dim RowCrnt As Integer

  RowCrnt = 1
  With Sheets("Sheet2")
    Do While True
      ' This loop is repeated for every cell in column A until it
      ' encounters a blank cell 
      NameCrnt = .Cells(RowCrnt, 1).Value
      If NameCrnt = "" Then Exit Do
      For Inx = 1 To Names.Count
        ' This matches the names in Sheet 2 with the named ranges.
        ' Names that cannot be found in the Names collection are ignored. 
        If Names(Inx).Name = NameCrnt Then
          RangeCrnt = Names(Inx).RefersTo          ' Extract full address of range 
          RangeCrnt = Mid(RangeCrnt, 2)            ' Discard =
          RangeCrnt = Replace(RangeCrnt, "$", "")  ' Remove $s
          Pos = InStr(RangeCrnt, "!")
          ' Save sheet name
          .Cells(RowCrnt, 2).Value = Mid(RangeCrnt, 1, Pos - 1)
          RangeCrnt = Mid(RangeCrnt, Pos + 1)      ' Discard sheet name
          .Cells(RowCrnt, 3).Value = RangeCrnt     ' Save full address of range
          Pos = InStr(RangeCrnt, ":")
          If Pos <> 0 Then
            RangeCrnt = Mid(RangeCrnt, 1, Pos - 1) ' Discard end of range if any
          End If
          .Cells(RowCrnt, 4).Value = .Range(RangeCrnt).Row
          .Cells(RowCrnt, 5).Value = .Range(RangeCrnt).Column
          Exit For
        End If
      Next
      RowCrnt = RowCrnt + 1
    Loop
  End With
End Sub

В результате получается таблица из пяти столбцов:

Col 1 = Range name  (unchanged)
Col 2 = Sheet name
Col 3 = Range
Col 4 = Top row of range
Col 5 = Left column of range

После сортировки по столбцам 4 и 5 таблица будет в указанной вами последовательности.