*[VBA]テキスト中の接頭文字+数値のキーコードを抽出する関数

Option Compare Database

'テキスト中、接頭文字固定のキーコードを抽出。
'複数埋め込まれている場合はカンマ区切りで返す
'Usage
'ret = GetKeyCode(検索対象となるテキスト,キーコード特定用の接頭文字,接頭文字以降の連番数)

Public Function GetKeyCode(sText As String, sPrefix As String, num As Long) As String
  
  
  Dim ns As Long '検索を開始する文字数
  Dim chkflg As Boolean '抽出成功フラグ
  Dim i As Long         'カウンタ
  Dim buf As String      '返す値を格納
  
  buf = ""
'最初の接頭文字を検索
  ns = InStr(1, sText, sPrefix)

'検索文字列Wが見つからなくなるまで繰り返し
  Do Until ns = 0
'判定フラグ初期化
    chkflg = True
 '見つかったW以降7文字
    For i = ns + 1 To ns + num
'数値型でない文字列が存在した場合はフラグを更新して数値判定を中止
      If IsNumeric(Mid(sText, i, 1)) = False Then
        chkflg = False
        Exit For
      End If
    Next i
    'すべて数値型であった場合は
    If chkflg Then
      '請求Noを取得
      If buf <> "" Then buf = buf & ","
      buf = buf & Mid(sText, ns, num + Len(sPrefix))
    End If
    '次のWを探す
    ns = InStr(ns + 1, sText, sPrefix)
    'ここまで繰り返し
  Loop

  GetKeyCode = buf

End Function