【VBA】テキストを取込み、数値だけを抽出する関数【TextToArray】

Excel/VBA

テキストファイルを読み込んで数値だけを抽出したい。そんな時に役立ちます。
 

スポンサーリンク

やりたい事

 

こんなファイルが有るとする

show status tunnel up
接続されているトンネルインタフェース

トンネル番号: 
   2    3  801  802  803  804  805  806  808  809  810 
# 

これはYAMAHAルーターに対し、どこのトンネルがリンクアップになってるか~ のログファイル。
このトンネル番号たちに対してリブートするコマンドファイルを作りたいので、数値のみ抽出したいってのが今回やりたい事。

なので数値だけを抽出して配列に入れて返却させましょう!

TextToArray

 

参照の追加も特に不要なので、以下コピッペでOK。

'*******************************************************************
'* TEXTファイル→数値配列化処理                                    *
'*******************************************************************
Function TextToArray(strFileAddress As String) As String()

    Dim arr() As String    ' 返却する配列
    
    Dim strLine As String  ' 読み込んだテキスト1行
    Dim nLenCnt As Long    ' 1行の文字列の長さ

    Dim strNum As String   ' 抽出する文字列
    Dim nNumCnt As Long    ' 抽出した文字列の数
    
    ' TEXTオープン
    Open strFileAddress For Input As #1

    ' 最終行まで1行ずつ読み込む
    Do Until EOF(1)

       Line Input #1, strLine
       ' 読み込んだLineの文字数分ループ
       For nLenCnt = 1 To Len(strLine)
           ' 数値判定
           If IsNumeric(Mid(strLine, nLenCnt, 1)) Then
              ' 数値が続く場合それは一つの数値なので結合させる
              strNum = strNum + Mid(strLine, nLenCnt, 1)
           ' 文字列の場合
           Else
              ' strTunnelNumに数値が入っている場合
              If strNum <> "" Then
                 ' 数値の終わりなので格納
                 ReDim Preserve arr(nNumCnt)
                 arr(nNumCnt) = strNum
                 nNumCnt = nNumCnt + 1
                 strNum = ""
              End If
           End If
       Next
    Loop
    
    ' strNumに数値が入っている場合
    If strNum <> "" Then
       nNumCnt = nNumCnt + 1
       ReDim Preserve arr(nNumCnt)
       arr(nNumCnt) = strNum
       strNum = ""
    End If
    
    ' TEXTクローズ
    Close #1
    ' 返却値
    TextToArray= arr()
    
End Function

さすがに数値同士がくっついてるって事は無いと思うので、大体のテキストファイルは上記で行けるはず。間にカンマやタブ、スペース等が入っていれば問題無し。

ちなみに拡張子は.txtでなくてもエディタで普通に開けるものなら何でも行けます。

呼び出し元はこんな感じ。いつものドラッグアンドドロップスタイルでファイル取込み

'*******************************************************************
'* ドラッグ&ドロップ時処理                                        *
'*******************************************************************
Private Sub ListView_OLEDragDrop(Data As MSComctlLib.DataObject, _
Effect As Long, Button As Integer, Shift As Integer, _
x As Single, y As Single)

    Dim arr() As String    ' 抽出した数値を格納する配列

    ' TEXTファイル→数値配列化処理
    arr = TextToArray(Data.Files(1))

    ' 配列の中身を表示
    MsgBox Join(arr, vbCrLf)
    
End Sub

取り敢えず実行結果が分かりやすい様にMsgBox表示してみた。

実際の動き

 

以下実行結果↓

取り込みを行うテキストファイルによって様々癖があると思うので、必要であれば色々カスタマイズしてください(ᵔᴥᵔ)

コメント