Question

我想将工作簿中的现有名称传递给数组并将数组重命名为UBound限制，但我甚至无法获得返回名称的第一个基础。

我正在准备一个非常基本的蒙特卡罗模拟，并希望将数组用于输入和输出，因为我们将作为创建Histogtram和Cumualtive图表的基础。

Sub RangeCheck_()
Dim N As Name
For Each N In ActiveSheet.Names
MsgBox N
Next N
End Sub

即使这个非常基本的例程也不适用于定义了40个名称的工作表。欣赏我可以使用一个简单的Range（“X”）。listnames保存名称列表，然后将其提供给一个数组，但它非常笨拙，我希望有人能提出更好的解决方案。我在Excel 2011中这样做，以防万一。

谢谢你

彼得

Answer 1

考虑：

Sub qwerty()
    Dim n As Name
    For Each n In ActiveWorkbook.Names
        MsgBox n.Name
    Next n

    nCount = ActiveWorkbook.Names.Count
    Dim ary
    ReDim ary(1 To nCount) As String

    For i = 1 To nCount
        ary(i) = ActiveWorkbook.Names(i)
    Next i
End Sub

Answer 2

试试这个。它是一维数组，因此如果您需要2D变体，则需要额外的代码：

Option Explicit

Public Function AllTheWorkbookNames(Optional myWorkbook As Excel.Workbook) As Variant
' Return a one-dimensional array of all the names in a Workbook
' Uses the current workbook if the myWorkbook parameter is omitted


Dim xlName   As Excel.Name
Dim xlSheet  As Excel.Worksheet
Dim arrNames As Variant
Dim strNames As String


If myWorkbook Is Nothing Then
    Set myWorkbook = ThisWorkbook
End If


' join up the workbook-level names in a string, separated by a character
' (vbNullChar) that can't be used in in range names and worksheet names:
For Each xlName In myWorkbook.Names

    strNames = strNames & xlName.Name & Chr(0)

Next xlName

' Join up the worksheet-level names. Chr(34) is just the character for a
' single quote, we're using it because "'" is bad for code readability:
For Each xlSheet In myWorkbook.Worksheets

    For Each xlName In myWorkbook.Names

        strNames = strNames & Chr(34) & xlSheet.Name & Chr(34) & "!" & xlName.Name & Chr(0)

    Next xlName

Next xlSheet


' Trim the trailing delimiter:
strNames = Left(strNames, Len(strNames) - 1)

' Use the 'split' function to turn this string into an array:
arrNames = Split(strNames, Chr(0))

AllTheWorkbookNames = arrNames


Erase arrNames

End Function

2D阵列的附加代码是：

Dim i As Long

ReDim arr2D(LBound(arrNames) To LBound(arrNames), 0 To 0)
For i = LBound(arrNames) To LBound(arrNames)
    arr2D(i, 0) = arrNames(i)
Next

AllTheWorkbookNames = arr2D

将Excel工作簿中的所有范围名称传递给数组

2 个答案: