查找具有特定命名范围的所有工作表答案

【问题标题】：Find all worksheets with a specific named range查找具有特定命名范围的所有工作表
【发布时间】：2020-07-13 19:24:19
【问题描述】：

我在 MS Access 中运行一个例程来操作 MS Excel。我正在从工作簿中的所有工作表中制作一个合并报告工作表。只有一些工作表具有“dockName”的命名范围。我的例程是用停靠名称和相关的工作表名称制作一个数组。在合并的工作表中，我包含了一个停靠名称列表和指向其相关工作表的超链接。

下面的代码有效，但它两次横穿工作表，我相信有更好的方法来获取命名范围为“dockName”的工作表总数

   ' cycle through each worksheet to find out if
   ' the worksheet has a named range of "dockName"
   ' if the named range is found increment irow

   For Each ws In wbWorking.Worksheets
        On Error Resume Next
            Set rngDock = ws.Range("dockName")
        On Error GoTo err_trap
        If Not rngDock Is Nothing Then
            irow = irow + 1
        End If
    Next ws

    If Not ws Is Nothing Then Set ws = Nothing

    ' redim an array with the appropriate number of rows
    icol = 1
    ReDim vDockSheetNames(irow, icol)
    irow = 0

    ' cycle through the worksheets and gather the 
    ' dockName and worksheet Name into vDockSheetNames array

    For Each ws In wbWorking.Worksheets
        On Error Resume Next
            Set rngDock = ws.Range("dockName")
        On Error GoTo err_trap
        If Not rngDock Is Nothing Then
            vDockSheetNames(irow, 0) = rngDock.Value2
            vDockSheetNames(irow, 1) = ws.name
            irow = irow + 1
        End If
    Next ws

【问题讨论】：

您可以循环检查dockName的名称，每次找到时使用Redim扩展您的数组并记录工作表和值。
@SJR 我读过多次重新调整数组效率很低。我不知道循环遍历工作表两次的低效率是否等同于 redim 的低效率。其中一些工作簿可能包含数百个工作表，但其中只有一小部分包含有关特定码头的信息。
我也不知道——也许值得一试。另一种选择是根据文件中命名范围的总数在开始时仅重新调整一次。然后你知道你将有足够的空间（你最终会在你的数组中得到“空”空间，但这没关系。

标签： excel ms-access vba

【解决方案1】：

ReDim很多次都没问题。

Sub TestRedim()

    Dim myAr() As String
    Dim i As Long
    Dim TimeStart As Single

    TimeStart = Timer()
    For i = 1 To 1000000
        ReDim Preserve myAr(1 To i)
        myAr(i) = "Sheet " & i
    Next i

    MsgBox "That took " & Format(Timer - TimeStart, "0.000") & " seconds.", vbInformation

End Sub

我必须将循环次数增加到 100 万次才能使时间超过 1 秒。

这需要我的电脑 1.1 秒。与

    Dim myAr(1 To 1000000) As String

如果没有 ReDim 行，它是 0.4 秒。真的不值得进一步思考。

正如 SJR 所写，ReDim 在您的第一个循环中。循环 Worksheets 集合并检查命名范围的成本要高得多。

【讨论】：

【解决方案2】：

基于@SJR 的建议和@Andre 的支持建议，我生成了以下函数，该函数返回给定工作簿中给定命名范围的计数。返回值可用于重新调整数组。此功能比遍历工作表收集和测试命名范围要快得多。

Function getCountOfNamedRanges(ByRef wb As Excel.Workbook, ByVal rngName As String) As Integer
    ' return the number of times a given rngName appears in the given workbook
    Dim nm As Variant
    Dim nms As Names
    Dim i As Integer
    Dim iReturn As Integer

    Set nms = wb.Names
    For i = 1 To nms.Count
        If InStr(1, nms(i).Name, rngName) Then iReturn = iReturn + 1
    Next i
    countNameRanges = iReturn
End Function

【讨论】：