FC2ブログ

スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

文字の抜き出し その2 


過去記事「文字の抜き出し」で、単発的なものをやってみました。
今回は、チョッと単発では終わらなそうなものを、勉強がてら VBScript.RegExp を使って見たいと思います。

以下の様な質問を見かけました。

<ファイル名:aaa.txt>
<div>
<div>
<h1>参加国</h1>

<div id="Country">
<div id="organizationsBox">
<h1>アメリカ<br>
シカゴ</h1>

<h1>日本<br>
東京<br />大阪</h1>

<h1><b>ロシア</b><br><i>モスクワ</i></h1>

<h2></h2>
<div>
<p>内容</p>
<h1><b>イギリス</b></br><h1a><i>ロンドン</i></h1a></h1>

</div>
<h2>人数</h2>
<div></div>
<h2>メモ</h2>

上記ファイルがあった時、
 <div id="Country"> 出現後、<h1> ~ </h1> で囲まれた物を抽出したい。
ただ、<br> で区切った先頭と、指定したものが一致するもので <br> 以降を返してほしい
つまり、「アメリカ」を指定したら「シカゴ」を返してほしい。
また、上記で「日本」を指定したら「東京 大阪」を返してほしい。

操作は Excel 上として
 ABCD
1アメリカaaa.txt  
2日本aaa.txt  
3ロシアaaa.txt  
4イギリスaaa.txt  
とあったら、

 ABCD
1アメリカaaa.txtシカゴ 
2日本aaa.txt東京 大阪 
3ロシアaaa.txtモスクワ 
4イギリスaaa.txtロンドン 
の様に求めたい。

※ B列のファイル名に対しては、ActiveWorkbook.Path & "\" を付加するものとする

内容自体は、形式に添ったものが丸々あるわけではなさそう・・・
 ・・・私も良くやります(部分的にコピーして取っておく・・・ とか)

その中で、最低限の条件で一致させて・・・
また、<br> 部分も </br> とか <br /> とか・・・ 指定されたもので区切りましょうか・・・
さらに、実際にあるかどうかわからないタグ <h1a> </h1a> とか・・・ なかった事に解釈してみましょうか・・・

※ 上記のファイルの内容は、私が適当にいじくりまわしていますが・・・
 
処理は関数を呼んで・・・ 用意した関数の I/F は、
Private Function fncSearch(FilePath As String, Country As String _
          , Optional Separate As String = " " _
          , Optional tag As String = "h1" _
          , Optional tagBreak As Variant = "<br>") As String

FilePath:読み込むファイルのフルパス
Country:抽出部分の指定 (例:アメリカ とか 日本)
Separate:複数ある時の区切り文字 (例:東京▲大阪 の▲部分・・・ 標準ではスペース)
tag:どのタグにあるものか指定 (標準では h1)
tagBreak:上記 tag 内で区切りとして解釈する文字列 (標準では <br>)
 この文字列を複数指定する場合は、Array("<br>", "</br>", "<br />") の様に

で、この関数を呼んでみると
Public Sub test()
  Dim iRow As Long

  For iRow = 1 To Range("A" & Rows.Count).End(xlUp).Row
    Cells(iRow, 3) = fncSearch(ActiveWorkbook.Path & "\" & Cells(iRow, 2), Cells(iRow, 1) _
              , "、", "h1", Array("<br>", "</br>", "<br />"))
  Next
End Sub

 
上記では、tag 内区切りを配列で指定して、戻してもらう時の区切りに "、" を指定・・・
これにより、日本の場合は、「東京、大阪」が得られる事に・・

まずは記述したものを
Private Function fncSearch(FilePath As String, Country As String _
          , Optional Separate As String = " " _
          , Optional tag As String = "h1" _
          , Optional tagBreak As Variant = "<br>") As String
  Static oRE As Object
  Dim sTag As String, sTagBreak As String
  Dim sBuf As String, sS As String
  Dim v As Variant
  Dim i As Long

  fncSearch = ""
  If ((Len(Separate) = 0) Or (Len(tag) = 0)) Then Exit Function
  If (IsEmpty(tagBreak) Or IsNull(tagBreak)) Then Exit Function
  sTag = "<" & tag & ">.*?</" & tag & ">"
  If (IsArray(tagBreak)) Then
    sTagBreak = ""
    For Each v In tagBreak
      sTagBreak = sTagBreak & "|" & v
    Next
    sTagBreak = "(" & Mid(sTagBreak, 2) & ")"
  Else
    sTagBreak = tagBreak
  End If

  On Error GoTo ERR_HND
  With CreateObject("Scripting.FileSystemObject")
    With .OpenTextFile(FilePath)
      sBuf = Replace(.ReadAll, vbCrLf, "")
      .Close
    End With
  End With
  sBuf = Split(sBuf, "<div id=""country"">", , vbTextCompare)(1)
  If (oRE Is Nothing) Then Set oRE = CreateObject("VBScript.RegExp")
  With oRE
    .Global = True
    .IgnoreCase = True
    .Pattern = sTag
    For Each v In .Execute(sBuf)
      sS = v.Value
      .Pattern = sTagBreak
      sS = .Replace(sS, Separate)
      .Pattern = "<.*?>"
      sS = .Replace(sS, "")
      If (Split(sS, Separate)(0) = Country) Then
        i = InStr(sS, Separate)
        If (i > 0) Then fncSearch = Mid(sS, i + Len(Separate))
        Exit Function
      End If
    Next
  End With
ERR_EXIT:
  Exit Function

ERR_HND:
  fncSearch = "#Err : " & Err.Number
  Resume ERR_EXIT
End Function

 
やっている事を順に説明してみると、
・引数の指定状況確認
・抽出パターンの生成
  sTag = "<" & tag & ">.*?</" & tag & ">"
で、抽出パターン <h1>.*?</h1> を作っておきます( h1 が指定されていた場合)
・区切り解釈パターンの生成
  If (IsArray(tagBreak)) Then
    sTagBreak = ""
    For Each v In tagBreak
      sTagBreak = sTagBreak & "|" & v
    Next
    sTagBreak = "(" & Mid(sTagBreak, 2) & ")"
  Else
    sTagBreak = tagBreak
  End If
で、"<br>" だけなのか "(<br>|</br>|<br />)" なのか分岐生成
これは、上記パターンのものを Separate で指定されたものに置換える準備になります。
・指定されたファイルを一気に読み込み、改行(vbCrLf)を削除して、ズラズラな文字列に・・・
・<div id="country"> 以降の文字列を処理対象に
・以降で VBScript.RegExp を使用し、作っておいた抽出パターン sTag で順次抽出
・抽出された物に、区切り解釈パターンを適用し、残った <~> 部分を削除
 例えば
<h1><b>ロシア</b><br><i>モスクワ</i></h1>
が抽出されたら、区切り解釈パターンを適用し
<h1><b>ロシア</b>、<i>モスクワ</i></h1>
にしてから、不要な <~> 部分を削除すると
ロシア、モスクワ
となります
・置き換えた区切りで解釈した先頭が、指定された抽出部分にあたるのなら、以降の文字列を返す

説明が足りないかもしれませんが、こんな感じで・・・・
ファイルは、一気に読み込んで切り貼りしていくと、結構処理を記述しやすいですね。

じゃ、1行1行読み込みながらって・・・ やってみるかな
ということで、以下
Private Function fncSearch(FilePath As String, Country As String _
          , Optional Separate As String = " " _
          , Optional tag As String = "h1" _
          , Optional tagBreak As Variant = "<br>") As String
  Static oRE As Object
  Dim sTagS As String, sTagE As String
  Dim sTagBreak As String
  Dim v As Variant
  Dim sBuf As String, sRbuf As String, sS As String
  Dim bFound As Boolean
  Dim iPosS As Long, iPosE As Long

  fncSearch = ""
  If ((Len(Separate) = 0) Or (Len(tag) = 0)) Then Exit Function
  If (IsEmpty(tagBreak) Or IsNull(tagBreak)) Then Exit Function
  sTagS = "<" & tag & ">"
  sTagE = "</" & tag & ">"
  If (IsArray(tagBreak)) Then
    sTagBreak = ""
    For Each v In tagBreak
      sTagBreak = sTagBreak & "|" & v
    Next
    sTagBreak = "(" & Mid(sTagBreak, 2) & ")"
  Else
    sTagBreak = tagBreak
  End If
  bFound = False

  On Error GoTo ERR_HND
  With CreateObject("Scripting.FileSystemObject")
    With .OpenTextFile(FilePath)
      While (Not .AtEndOfStream)
        sRbuf = .ReadLine
        If (Not bFound) Then
          If (InStr(1, sRbuf, "<div id=""country"">", vbTextCompare) > 0) Then
            bFound = True
            sBuf = ""
          End If
        Else
          sBuf = sBuf & sRbuf
          iPosE = InStrRev(sBuf, sTagE, , vbTextCompare)
          If (iPosE > 0) Then
            iPosS = InStrRev(sBuf, sTagS, iPosE, vbTextCompare)
            If (iPosS > 0) Then
              If (oRE Is Nothing) Then Set oRE = CreateObject("VBScript.RegExp")
              With oRE
                .Global = True
                .IgnoreCase = True
                .Pattern = sTagBreak
                sS = .Replace(Mid(sBuf, iPosS, iPosE - iPosS), Separate)
                .Pattern = "<.*?>"
                sS = .Replace(sS, "")
                If (Split(sS, Separate)(0) = Country) Then
                  iPosS = InStr(sS, Separate)
                  If (iPosS > 0) Then fncSearch = Mid(sS, iPosS + Len(Separate))
                  Exit Function
                End If
              End With
            End If
            sBuf = Mid(sBuf, iPosE + Len(sTagE))
          End If
        End If
      Wend
      .Close
    End With
  End With
ERR_EXIT:
  Exit Function

ERR_HND:
  fncSearch = "#Err : " & Err.Number
  Resume ERR_EXIT
End Function

 
やっている処理の基本は、一気に読み込んだ場合と大差はありません。
読み込んだものに </h1> があるか・・・
あったら、それ以前に <h1> があるか・・・
それもあったら、<h1> ~ </h1> の前までを解釈する様に・・・
一気の場合は
<h1><b>ロシア</b><br><i>モスクワ</i></h1>
を処理対象としていましたが、今回は
<h1><b>ロシア</b><br><i>モスクワ</i>
を解釈する様に・・・  </h1> があろうが無かろうが、影響ないですね

こんな感じになっちゃいましたけど・・・
この処理には、前提条件がチョッとあって
・<div id="country"> 部分を読み込んだ時、余計なものは他の行にある事・・・
 (それなりの処理を入れれば良いのかも・・・)

また、懸念が一箇所・・・
                  If (iPosS > 0) Then fncSearch = Mid(sS, iPosS + Len(Separate))
                  Exit Function
ここで、単に Exit Function していますが、オープン中のファイルはどうする・・・
    With .OpenTextFile(FilePath)
          ・・・・・・・・・・
              With oRE
っていう書き方しちゃってたから・・・ 仕方ないんですね
Exit Function した後、With .OpenTextFile(FilePath) のはチャンと閉じてくれるんですよね??

まっ、書き方を変えればいいんですけど・・・・


今回、サンプルファイルはありません
関連記事

2013/09/16

Category: やってみる

TB: --  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。