人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

VBAについて質問です。

現在フォルダに入っているtxtファイルのデータで、抜き出したいデータを正規表現で順番に抜き出す作業をしたいと考えています。

しかし、自分の力では現在スクリプトを作成できない状況です。やや緊急で大変お手数をおかけしますがスクリプトを作成していただける方おりましたら作成していただけないでしょうか

スクリプト手順ですが

?フォルダを指定する
?指定されたフォルダにあるテキストを名前が若い番号から順に開いて正規表現していく。
?必要データの抜き取り
列Aにtxtファイルの名前(.txtの前の値)を入れる。
列Bにtxtファイルに書いてある 生産国: ★値★ <br>の値の部分を抜き出し書き込み。
列Cにtxtファイルに書いてある 素材・色 : ★値★ <br>の値の部分を抜き出し書き込み。
列Dにtxtファイルに書いてある サイズ : ★値★ <br>の値の部分を抜き出し書き込み。

これをファイルが入っている所までやりたいと考えているのですが
回答できるかたおりましたらご回答いただければと考えております。
よろしくお願いいたします。


●質問者: aiomock
●カテゴリ:コンピュータ インターネット
✍キーワード:txt VBA サイズ スクリプト テキスト
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● airplant
●100ポイント ベストアンサー

どなたからも回答がなかったので、久しぶりに作ってみました。


なお、文章が一部不明だったので、次のように捉えました。

?(丸2):「名前が若い番号から順に開いて正規表現していく。」

→ファイル名昇順でリストに作る(処理の都合上、この処理は最後に行った)


パターン:

「素材・色 : ★値★ <br>の値の部分を抜き出し」

→ キーワード 半角・全角ブランクが0-n個 : 半角・全角ブランクが0-n個 その後が値 <br> とみなした

もし、常に★で囲まれているのであれば、パターンの(.*?)を★で囲んでください。あっ、その後に空白があってから<br>であれば、そのように変更ください。

Option Explicit

Const ForReading As Integer = 1  ' FSO

Const sColFile As String = "A"  ' カラム定義
Const sColCountry As String = "B"
Const sColColor As String = "C"
Const sColSize As String = "D"

Const sCountry As String = "生産国[  ]*:[  ]*(.*?)<br>"
Const sColor As String = "素材・色[  ]*:[  ]*(.*?)<br>"
Const sSize As String = "サイズ[  ]*:[  ]*(.*?)<br>"


Sub SearchValue()
 
 Dim sPath As String
 Dim vName As Variant
 Dim fs As Object, ts As Object
 Dim sBuf As String
 Dim lnRow As Long
 
 Set fs = CreateObject("Scripting.FileSystemObject")
 sPath = InputBox("フォルダ名")
 If sPath = "" Then Exit Sub
 sPath = sPath & "\"
 vName = Dir(sPath & "*.txt")  ' 最初のファイル
 lnRow = 1
 Do While vName <> ""
 Set ts = fs.OpenTextFile(sPath & vName, ForReading)
 sBuf = ts.ReadAll
 ts.Close
  ' 正規表現でファイル中から探してセルへ設定
 Cells(lnRow, sColFile) = Left(vName, Len(vName) - 4)
 Cells(lnRow, sColCountry) = sReg(sBuf, sCountry)
 Cells(lnRow, sColColor) = sReg(sBuf, sColor)
 Cells(lnRow, sColSize) = sReg(sBuf, sSize)
 vName = Dir  ' 次のファイル
 lnRow = lnRow + 1
 Loop
 
 Range(sColFile & "1" & ":" & sColSize & (lnRow - 1)).Sort _
 Key1:=Range(sColFile & "1")  '並べ替え
End Sub


Function sReg(strTrg As String, sPattern As String) As String
 Dim re As Object
 Dim mc As Object
 
 Set re = CreateObject("VBScript.RegExp")
 With re
 .Pattern = sPattern
 .MultiLine = True
 .IgnoreCase = True
 Set mc = .Execute(strTrg)
 End With
 If mc.Count >= 1 Then
 sReg = mc(0).SubMatches(0)
 Else
 sReg = ""
 End If

End Function

P.S.以前も記載しましたが、一冊VBAの本を買っておくといいと思います。

◎質問者からの返答

ご回答ありがとうございます。


2 ● tuiteruyy
●35ポイント

windowsに標準装備されているコマンドプロンプトでやるとカンタンですよ。

しかも、スクリプトをかくのもテキストファイルに書いて、拡張子をbatにして保存するだけです。

バッチファイルの命令文

http://www.tkssoft.com/cmd/

◎質問者からの返答

ご回答ありがとうございます。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ