Excl-VBA 空白でない文字の開始位置を検索しデータを抽出

こんにちは！健史です。

文字列操作において「InStr」は不可欠の関数で、予め決まった文字列の開始位置を返してくれます。

例えば、
MsgBox InStr(1, "文字は AB CDE", "CDE")
では[8]が表示されます。

しかし特定文字列ではなく空白でない文字の開始位置を求めたいことがあります。

”CDE”など決まっている文字列ではなく、また、区切り空白の個数が1個ではなく可変であることもあります。

目　次　

プログラム
空白で区切られえた文字列を抽出する
最後に

プログラム

以下は、"文字は AB CDE"を空白で分解して表示します。

    Dim pos_st, pos_len, pos_len1, pos_end As Long
    Dim defDat, strTxt1 As String
'             1 2 3 4567890
    defDat = "文字は AB CDE"
'データ長を求める
    pos_len = Len(defDat)
'最初の文字列を求める → [文字は]が表示される
    pos_st = 1
    Do Until pos_st > pos_len Or Mid(defDat, pos_st, 1) <> " "
        pos_st = pos_st + 1
    Loop
    If pos_st > pos_len Then
        MsgBox "開始位置から、空白以外の文字はない"
        Exit Sub
    Else
        pos_end = InStr(pos_st, defDat, " ")
        If pos_end = 0 Then
            pos_end = Len(defDat) + 1
        End If
        pos_len1 = pos_end - pos_st
        strTxt1 = Mid(defDat, pos_st, pos_len1)
        MsgBox strTxt1
    End If
'２つ目の文字列を求める → [AB]が表示される
    pos_st = pos_end
    Do Until pos_st > pos_len Or Mid(defDat, pos_st, 1) <> " "
        pos_st = pos_st + 1
    Loop
    If pos_st > pos_len Then
        MsgBox "開始位置から、空白以外の文字はない"
        Exit Sub
    Else
        pos_end = InStr(pos_st, defDat, " ")
        If pos_end = 0 Then
            pos_end = Len(defDat) + 1
        End If
        pos_len1 = pos_end - pos_st
        strTxt1 = Mid(defDat, pos_st, pos_len1)
        MsgBox strTxt1
    End If
'３つ目の文字列を求める → [CDE]が表示される
    pos_st = pos_end
    Do Until pos_st > pos_len Or Mid(defDat, pos_st, 1) <> " "
        pos_st = pos_st + 1
    Loop
    If pos_st > pos_len Then
        MsgBox "開始位置から、空白以外の文字はない"
        Exit Sub
    Else
        pos_end = InStr(pos_st, defDat, " ")
        If pos_end = 0 Then
            pos_end = Len(defDat) + 1
        End If
        pos_len1 = pos_end - pos_st
        strTxt1 = Mid(defDat, pos_st, pos_len1)
        MsgBox strTxt1
    End If
'４つ目の文字列を求める → [開始位置から、空白以外の文字はない]が表示される
    pos_st = pos_end
    Do Until pos_st > pos_len Or Mid(defDat, pos_st, 1) <> " "
        pos_st = pos_st + 1
    Loop
    If pos_st > pos_len Then
        MsgBox "開始位置から、空白以外の文字はない"
        Exit Sub
    Else
        pos_end = InStr(pos_st, defDat, " ")
        If pos_end = 0 Then
            pos_end = Len(defDat) + 1
        End If
        pos_len1 = pos_end - pos_st
        strTxt1 = Mid(defDat, pos_st, pos_len1)
        MsgBox strTxt1
    End If

コメントの「２つ目の文字列を求める」～「４つ目の文字列を求める」までの処理内容は全く同じです。

「最初の文字列を求める」も、[pos_st = 1]と[pos_st = pos_end]が異なるだけで同じです。

説明上、敢えて載せています。

目的を持った抽出、例えば"AB"という文字列の後の空白の後にある文字列([CDE])だけを抽出したい場合は、以下です。

    Dim pos_st, pos_len, pos_len1, pos_end As Long
    Dim defDat, strTxt1 As String
'             1 2 3 4567890
    defDat = "文字は AB CDE"
'データ長を求める
    pos_len = Len(defDat)
'ABの文字位置を求める
    pos_st = 1
    pos_st = InStr(pos_st, defDat, "AB")
    If pos_st = 0 Then
        MsgBox "ABの文字はない"
        Exit Sub
    End If
'ABの後の空白位置を求める
    pos_end = InStr(pos_st, defDat, " ")
    If pos_end = 0 Then
        MsgBox "ABの後に空白文字はない"
        Exit Sub
    End If
'ABの後の空白の後の文字列を抽出する
    pos_st = pos_end
    Do Until pos_st > pos_len Or Mid(defDat, pos_st, 1) <> " "
        pos_st = pos_st + 1
    Loop
    If pos_st > pos_len Then
         MsgBox "開始位置から、空白以外の文字はない"
    Else
         pos_end = InStr(pos_st, defDat, " ")
         If pos_end = 0 Then
             pos_end = Len(defDat) + 1
         End If
         pos_len1 = pos_end - pos_st
         strTxt1 = Mid(defDat, pos_st, pos_len1)
         MsgBox strTxt1
    End If

空白で区切られえた文字列を抽出する

最初に紹介したプログラムについて、重複部分をなくし簡素化したループ文としました。

    Dim pos_st, pos_len, pos_len1, pos_end As Long
    Dim defDat, strTxt1 As String
'             1 2 3 4567890
    defDat = "文字は AB CDE"
'データ長を求める
    pos_len = Len(defDat)
'最初は1桁目から求める
    pos_st = 1
'ループ処理
    Do
        Do Until pos_st > pos_len Or Mid(defDat, pos_st, 1) <> " "
            pos_st = pos_st + 1
        Loop
        If pos_st > pos_len Then
             MsgBox "開始位置から、空白以外の文字はない"
             Exit Do
        Else
             pos_end = InStr(pos_st, defDat, " ")
             If pos_end = 0 Then
                 pos_end = Len(defDat) + 1
             End If
             pos_len1 = pos_end - pos_st
             strTxt1 = Mid(defDat, pos_st, pos_len1)
             MsgBox strTxt1
        End If
'     ２項目以降の開始位置は、１つ前で処理した終了位置
        pos_st = pos_end
    Loop

最後に

ネットで検索したところ、InStrは決まっている文字列の開始位置を求めますが「空白以外の文字」は求められないようでした。

コーディングされたプログラムなどは、項目名の長さ、項目名と命令との空白文字の個数もバラバラです。

そのようなテキストデータからデータを抽出する場合にも、空白でない文字の開始位置を求めることが不可欠です。

上記プログラムは[AB]の前後の空白の個数を多くして実行しても動作します。

ちなみにSplit関数で空白の個数が可変の場合には、Variant配列に有効値だけを抽出できず、空白も取り出されます。

また、今回のプログラムはロジックの説明を重視し、対象データを[defDat]に定義したプログラムにしました。

処理に必要な変数は[Dim pos_st, pos_len, pos_len1, pos_end As Long]だけです。
([strTxt1]は分かりやすくするために設けた変数で、直接セルなどを指定すれば不要)

シートのデータやファイルのデータを分解してシートに出力するなどの場合には、他の記事で紹介しているプログラムを参考に作成頂ければと思います。