特定の名前付き範囲を持つすべてのワークシートを見つける

Question

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 

Answer 1

@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 

Answer 2

それが全く問題ありません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 

私は1秒以上の時間を得るためにループの数を100万にクランクしなければならなかった。

これはコンピュータに1.1秒かかります。

Dim myAr(1 To 1000000) As String 

ReDimの行は0.4秒です。それ以上の考えをする価値はありません。

SJRが書いたように、最初のループにはReDimがあります。 Worksheetsコレクションをループし、名前付き範囲を確認するのは、規模によってさらに高価です。