フォルダ内のテキストファイルを書き出し
2022年03月31日
前に似たようなものを作ったんだけど、
流用して作ろうとしたら使い勝手が悪かったので改良してみた。
前から気になってたVBAのFIlter関数も使って
シンプルかつ強力に！
機能は、特定フォルダの中のテキストファイルを開いて中身を全部書き出すこと。
なので、フォルダのパスを入力するとテキストの中身を出力する関数として作った。
通常であれば、エクセルを使って不要行の削除とかをするんだけど、
１００万行とかあるので、シートに書き起こす前に
配列のままフィルタリングをする。
昔は、シートありきだったけど成長したなぁ。
いつものように配列のサイズ計算がめんどくさいので、
データの格納段階で無駄にDictionary配列を使う。
重複削除についてもDictionary型のキー格納を使って
エラー無視でぶん回す。
この内容なら、VBScriptに移植もできそうだな。
余談だけど、配列をエクセルファイルに張り付ける際に、
WorksheetFunction.Transpose関数を使うと、
要素数が多すぎると停止するので要注意。
２次元配列に格納しなおして張り付けた方がよさげ。
以下、ソース。
流用して作ろうとしたら使い勝手が悪かったので改良してみた。
前から気になってたVBAのFIlter関数も使って
シンプルかつ強力に！
機能は、特定フォルダの中のテキストファイルを開いて中身を全部書き出すこと。
なので、フォルダのパスを入力するとテキストの中身を出力する関数として作った。
通常であれば、エクセルを使って不要行の削除とかをするんだけど、
１００万行とかあるので、シートに書き起こす前に
配列のままフィルタリングをする。
昔は、シートありきだったけど成長したなぁ。
いつものように配列のサイズ計算がめんどくさいので、
データの格納段階で無駄にDictionary配列を使う。
重複削除についてもDictionary型のキー格納を使って
エラー無視でぶん回す。
この内容なら、VBScriptに移植もできそうだな。
余談だけど、配列をエクセルファイルに張り付ける際に、
WorksheetFunction.Transpose関数を使うと、
要素数が多すぎると停止するので要注意。
２次元配列に格納しなおして張り付けた方がよさげ。
以下、ソース。
ログフォルダ内のテキストのうち「,」「202」を含み、
「admin」「491」を含まない行を抽出する。
Option Explicit
Sub test()
Const Path As String = "D:\ログ\"
Dim aBuf: aBuf = フォルダ内のファイルの中身を取得(Path) 'フォルダ内のテキストを格納
Dim i As Long, k As Long 'ループ用 i:行、k:split
'対象行抽出
Const rowExtract = ",|202" '抽出文字列パイプ区切り
Dim arrExtract: arrExtract = Split(rowExtract, "|")
For k = 0 To UBound(arrExtract)
aBuf = Filter(aBuf, arrExtract(k), True)
Next k
'不要行削除
Const rowExclude = "admin|491|料金" '除外文字列パイプ区切り
Dim arrExclude: arrExclude = Split(rowExclude, "|")
For k = 0 To UBound(arrExclude)
aBuf = Filter(aBuf, arrExclude(k), False)
Next k
'重複削除
aBuf = dicFilter(aBuf, True)
Dim tmp: tmp = Split(aBuf(0), "|")
Dim iRowMax As Long: iRowMax = UBound(aBuf)
Dim iColMax As Long: iColMax = UBound(tmp)
Dim arr: ReDim arr(iRowMax, iColMax)
For i = 0 To iRowMax
tmp = Split(aBuf(i), "|")
For k = 0 To iColMax
arr(i, k) = tmp(k)
Next k
Next i
Cells(1, 1) = "ファイル名"
Cells(1, 2) = "行"
Cells(1, 3) = "テキスト"
Cells(2, 1).Resize(iRowMax, iColMax + 1).Value = arr
'https://www.kurumico.com/excel-vba-intermediate-filter/2791/#toc3で２次元をフィルタ
End Sub
Function dicFilter(arr, Optional onlyText As Boolean)
IsMissing onlyText = False '指定がなければテキスト部分のみで判定
On Error Resume Next '重複キーはエラーで排除（判定スキップ）
Dim Dic: Set Dic = CreateObject("Scripting.Dictionary")
Dim i As Long, tmp
For i = 0 To UBound(arr)
If onlyText = True Then 'テキスト部分でのみ判定するか
tmp = Split(arr(i), "|")
Dic.Add tmp(2), arr(i)
Else '別ファイルに同じテキストがあってもOK
tmp = Split(arr(i), "|")
Dic.Add tmp(0) & tmp(2), arr(i) 'エラー無視してキーに格納
End If
Next i
Dim Items: Items = Dic.Items
dicFilter = Items
End Function
Function フォルダ内のファイルの中身を取得(Path As String)
Const EXT = "*.*" '対象ファイルの拡張子
Dim Dic: Set Dic = CreateObject("Scripting.Dictionary")
Dim buf As String, cnt As Long, fcnt As Long
Dim fName As String: fName = Dir(Path & EXT) '1つ目のファイルを取得
Do While fName <> ""
Open Path & fName For Input As #1
fcnt = 1 'ファイル行カウンタを初期化
'ファイルを開いて
Do Until EOF(1)
Line Input #1, buf
Dic.Add cnt, fName & "|" & fcnt & "|" & buf '新規キーを登録 値はファイル名
fcnt = fcnt + 1
cnt = cnt + 1
Loop
Close #1
fName = Dir()
Loop
Dim Items: Items = Dic.Items 'fName & "|" & fcnt & "|" & buf
フォルダ内のファイルの中身を取得 = Items
End Function
PR
Comment