GetOpenFilenameを使用し、複数行のデータを抽出について

質問

エクセルVBA初心者です。
いろいろ調べましたが、うまくいかずご教授頂ければとお聞きします。
よろしくお願いします。

テキストファイル10万行からなるデータが入っています。
「aaa」と文字列を検索し、その下１０行を抽出したいのです。

Sub 抽出()

fname = Application.GetOpenFilename(FileFilter:="(*.*),[*.*]", Title:="data?", MultiSelect:=False)

if fname For Input As #1

Do
Line input as #1
If InStr(data, "aaa") > 0 Then
For i = 1 To 10
Cells(i, 1).Value = data
Next
End If
Loop Until EOF(1)
Close #1

End Sub

回答No.1

Alpha-j · ベストアンサー

以下に多少改善したコードを記入しますが、10万行のファイルを取り扱えるかは不明です。ご存知のとおりExcel2003までは65536行が最大値です。
また最初に開くファイルはテキストかCSVになっていますのでもしExcelでしたら txt → xls などに変更してください。また aaa を見つけた後10行を C:\test.txt へ吐き出すように作成しましたのでここも適当に書き換えてください。更に aaa は一回しか出現しないことを前提にしています。
よろしければ動作結果を再度 Up してください

Sub 抽出()

Dim filter As Variant
Dim title As Variant
Dim fname As Variant
Dim data As String
filter = "Textファイル (*.txt;*.csv),*.txt;*.csv"
title = "ディレクトリとファイルの選択"
fname = Application.GetOpenFilename(filter, , title, , False)

If fname <> "" then
Open fname For Input As #1
else
Exit Sub
End If

Do Until EOF(1)
Line input #1, data
If InStr(data, "aaa") > 0 Then
Open "C:\test.txt" For Output As #2
For i = 1 To 10
Write #2, data
Line input #1, data
Next
Close #2
Exit Do
End If
Loop

Close #1

End Sub

お礼

ご回答ありがとうございます！
詳しく説明しなかったのですが、"aaa"は多数出現するのです。。。
10万行で、Excelでは開けないので、必要な"aaa"の後の10行ずつだけ抽出したいと思ったのですが。

回答No.3

Alpha-j

他の条件はよろしいですか？
1. 最初に開くファイルはテキストかCSV。
2. また aaa を見つけた後10行を C:\test.txt へ吐き出す。
3. aaa は複数回出現する。
よろしければ動作結果を再度 Up してください

Sub 抽出()

Dim filter As Variant
Dim title As Variant
Dim fname As Variant
Dim data As String
filter = "Textファイル (*.txt;*.csv),*.txt;*.csv"
title = "ディレクトリとファイルの選択"
fname = Application.GetOpenFilename(filter, , title, , False)

If fname <> "" then
Open fname For Input As #1
else
Exit Sub
End If

Open "C:\test.txt" For Output As #2

Do Until EOF(1)
Line input #1, data
If InStr(data, "aaa") > 0 Then
For i = 1 To 10
Write #2, data
Line input #1, data
Next
End If
Loop

Close #1
Close #2

End Sub

お礼

お礼が遅くなり申し訳ありません。
ご回答ありがとうございます！
希望していたとおり動きました！
ところで、C:\test.txt の抽出結果に、全て「””」が付くのですが、
これはなぜでしょうか・・・。

回答No.2

Wendy02

こんばんは。

ちょっと試してみました。
10行の中で、「aaa」が現れても、カウントは、リセットされません。そのまま、10行を数えます。細かく、検証されていませんが、こんな感じなのかと思いました。

Sub Test1()
　　Dim fName As String
　　Dim fNum As Integer
　　Dim txtLine As String
　　Dim i As Long
　　Dim j As Integer
　　Dim flg As Boolean
　　fName = Application.GetOpenFilename( _
　　"テキストファイル(*.txt;*.csv),*.txt;*.csv", 1, "データ抽出")

　　If fName = "False" Or fName = "" Then Exit Sub

　　fNum = FreeFile()
　　i = 1
　　j = 0
　　Open fName For Input As #fNum
　　Do Until EOF(fNum)
　　　　Line Input #fNum, txtLine
　　　　'文字検索
　　　　If InStr(1, txtLine, "aaa", vbTextCompare) > 0 Then
　　　　　　flg = True
　　　　End If
　　　　If flg Then
　　　　　　Cells(i + j, 1).Value = txtLine
　　　　　　j = j + 1
　　　　　　'ワークシートの行の限界を越えたら離脱
　　　　　　If i + j > Rows.Count Then Exit Do
　　　　　　If j > 10 Then
　　　　　　　　flg = False
　　　　　　　　i = i + j
　　　　　　　　j = 0
　　　　　　End If
　　　　End If
　　Loop
　　Close #fNum
End Sub

お礼

お礼が遅くなり申し訳ありません。
ご回答ありがとうございます！
希望していたとおり動きました！
本当にありがとうございます。