0

我已经在工作表中命名了一个排列在另一个下的范围。

在用户窗体（包含列表框）的初始化事件中，当每个条目是一个命名范围的名称时，我将条目添加到列表框。

到目前为止，我设法根据命名范围的字母顺序将条目加载到列表中，因此以“a”开头的名称位于列表顶部，而“z”位于底部。

我希望条目按照它们在工作表中出现的顺序排列，因此靠近 A1 的命名范围将出现在列表顶部，A1 下的命名范围将是第二个条目，依此类推，直到最后一个命名工作表中的范围（在工作表的底部），这当然是最后一个条目。

谁能找到一种优雅的方式来做到这一点？

4

2 回答 2

1

Try this:

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
于 2011-12-05T19:33:00.487 回答
0

我不确定这是否是一个优雅的解决方案，但它是一个简单的解决方案。

下面的代码假定范围名称在 Sheet2 的单元格 A1、A2、A3 等中，并且列表以空白单元格终止。它还假设 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 列排序后，表格将按您查找的顺序排列。

于 2011-12-04T17:03:45.057 回答