ブック内で使用している関数の数をカウントするマクロ（Excel）

f:id:akashi_keirin:20210220222728j:plain

久しぶりのExcelネタだ。

とりあえずコードをぶちまける

f:id:akashi_keirin:20210220222511j:plain

現在（？）、Excelには、488個の関数があるらしい。

その488の関数名をコピッペしたこんなシートを用意して、

f:id:akashi_keirin:20210220222514j:plain

その関数名リストの部分に「FUNCTIONS_LIST」と名前を付けた。

これだけ準備をしておいて、このシートのモジュール（「Sh01Main」と名付けてある。）に、次のコードを書いた。

先に言っておく。長いぜ。

リスト１　シートモジュールSh01Main

Option Explicit

Private Const FUNCTIONS_LIST As String = "FUNCTIONS_LIST"

Private m_FunctionsArr As Variant '関数名リスト用'
Private m_CountArr() As Long      '関数使用数格納用'
Private m_FormulaArr As Variant   '各セルの数式格納用'
Private m_OpeArr() As String      '関数名のアタマの記号格納用'
Private m_CountArea As Range      '使用数書き込み先セル格納用'

Private Sub countFunctionsEntry(ByVal TgtBook As Workbook)
  '処理に使う変数等の準備'
  '関数名のアタマに付く可能性のある記号たち（網羅できている？）'
  Const PRE_OPERATORS As String = "= ( + - * / & < > ^ ,"
  m_OpeArr = Split(PRE_OPERATORS)
  m_FunctionsArr = Me.Range(FUNCTIONS_LIST).Value
  ReDim m_CountArr(1 To UBound(m_FunctionsArr, 1) + 1, 1 To 1)
  Set m_CountArea = Me.Range(FUNCTIONS_LIST).Offset(0, 1)
  Call m_CountArea.ClearContents
  'ブック内のワークシートごとにメソッド呼び出し'
  Dim tgtSh As Worksheet
  For Each tgtSh In TgtBook.Worksheets
    Call countSheetsFunctions(tgtSh)
  Next
  '最後に関数の使用数を書き込む'
  m_CountArea.Value = m_CountArr
End Sub

Private Sub countSheetsFunctions(ByVal TgtSheet As Worksheet)
'///シート内各セルの数式を取得'
  'UsedRangeがなかったら処理しなくて良い'
  If TgtSheet.UsedRange.Count = 0 Then Exit Sub
  'UsedRangeが1セルだったら、別途2次元配列化する'
  If TgtSheet.UsedRange.Count = 1 Then
    ReDim m_FormulaArr(1, 1)
    m_FormulaArr(1, 1) = TgtSheet.UsedRange.Cells(1, 1).Formula
  '2セル以上あるときは、直接2次元配列化'
  Else
    m_FormulaArr = TgtSheet.UsedRange.Formula
  End If
  '数式がある限り、一つ一つ調べる'
  Dim i As Long
  Dim j As Long
  For i = LBound(m_FormulaArr, 1) To UBound(m_FormulaArr, 1)
    For j = LBound(m_FormulaArr, 2) To UBound(m_FormulaArr, 2)
      If m_FormulaArr(i, j) = "" Then GoTo Continue
      Call countFunctions(m_FormulaArr(i, j))
Continue:
    Next
  Next
End Sub

Private Sub countFunctions(ByVal TgtFormula As String)
'///関数名ごとに数式内に含まれているかどうか調べる'
  If Left(TgtFormula, 1) <> "=" Then Exit Sub
  Dim i As Long
  Dim funcName As String
  Dim n As Long
  Dim result As Long
  For i = LBound(m_FunctionsArr, 1) To UBound(m_FunctionsArr, 1)
    funcName = m_FunctionsArr(i, 1)
    '「関数名 + (」が含まれていなければ調べなくて良い'
    If InStr(1, TgtFormula, funcName & "(") = 0 Then GoTo Continue
    Call detectFunction(TgtFormula:=TgtFormula, _
                        TgtFuncName:=funcName, _
                        TgtIndex:=i)
Continue:
  Next
End Sub

Private Sub detectFunction(ByVal TgtFormula As String, _
                           ByVal TgtFuncName As String, _
                           ByVal TgtIndex As Long)
'///「先頭記号 + 関数名 + (」が見つかるごとにカウントアップ'
  Dim n As Long
  Dim result As Long
  Dim i As Long
  For i = LBound(m_OpeArr) To UBound(m_OpeArr)
    n = 1
    Do
      result = InStr(n, TgtFormula, m_OpeArr(i) & TgtFuncName & "(")
      If result > 0 Then
        '見つかったら関数使用数格納用配列の当該要素をカウントアップ'
        m_CountArr(TgtIndex, 1) = m_CountArr(TgtIndex, 1) + 1
        n = result + Len(TgtFuncName) + 2
        '次の検索開始位置（result + (関数名の長さ + 2)） の値から、'
        '残りの文字数を調べる。                                    '
        '「2」は、関数名の前の文字と関数名の後ろの「(」の字数      '
        '残りの文字数が、関数名 + 2 （検索対象文字列の文字数）より '
        'も少なかったら検索終了。'
        If Len(TgtFormula) - n + 1 < Len(TgtFuncName) + 2 Then Exit Do
      Else
        Exit Do
      End If
    Loop
  Next
End Sub

Private Sub entryPoint()
'///エントリポイント'
'   同一フォルダ内の test.xlsm にある関数名をカウントする'
  Dim tgtBk As Workbook
  Set tgtBk = Application.Workbooks.Open( _
                            ThisWorkbook.Path & "\" & "test.xlsm")  '"
  Call countFunctionsEntry(tgtBk)
  Call tgtBk.Close(False)
End Sub

ふう。長いなあ……。

とりあえずコードを晒したかっただけなので、説明は省略。