CSVファイルの指定部分をエクセルに取り込みたい

質問

複数のCSVファイルをエクセルに、VBAを使用して取り込みます。
CSVファイルの形式は決まっているのですが、キーワード行から指定行分のみを取り込みたいです。

データ形式は、
Ａ１
aaa bbb ccc
Ｂ１
aaa bbb ccc
Ｃ１
aaa bbb ccc
Ａ１
a1a b1b c1c
　:
　:

という感じで、キーワードＡ１行以下から次のキーワードより上のデータをエクセルに取り込みたいです。

どうぞよろしくお願いいたします。

回答No.3

Wendy02 · ベストアンサー

こんばんは。

もし、#1,#2　の回答者の方のコードで解決するのでしたら良いのですが、私には質問の意味自体が良く理解できていません。

CSV ですから、まず、コンマ切りですね。スペース切りではありませんね。

>データ形式は、
>Ａ１
>aaa bbb ccc
>Ｂ１
>aaa bbb ccc
>Ｃ１
>aaa bbb ccc
>Ａ１
>a1a b1b c1c

>キーワードＡ１行以下から次のキーワードより上のデータ

何をキーワードにしているのですか？ キーワードA1行というのは、この場合は、「aaa bbb ccc」ということですか？

でも、A1,B1,C1 ということは、1行ですね。それとも、「(全角)のA1」とかいうものがキーワードなのでしょうか？つまり、次の「（全角）A1」 が現れるまで、インポートし続けることでしょうか？質問の例としては非常に紛らわしく混乱してしまいます。

もうひとつは、前回、CSVインポートを、QueryTable を使っていましたね。そうすると、QueryTable からでは、CSV ファイルの抜き出しは出来なかったと思います。別の内容なのですか？

もし、今までのを活かしていくなら、CSVのファイル単位でなくて、ワークシートの中で、メニュー－データ－[並べ替え] を利用した方法で、処理してしまってもよいかもしれません。マクロで行うのは理想かもしれませんが、今までのものを加工しようとしても、結局は、最初の段階から作り直すことになるだろうと思います。

もし、解決しているなら、こちらは無視して構いません。

お礼

前回に続き、ご回答ありがとうございます。ワンボタンで作業完了。とはなかなか行かないものなのですね。もう少し考えて見ます。ありがとうございました。

補足

説明不足失礼しました。csvファイルの『「(全角)のA1」とかいうものがキーワードで、次の「（全角）A1」 が現れるまで、インポートし続ける』ということになります。前回説明いただいたcsvインポートが希望通りだったので、手作業で対応を考えていた部分も、一気にマクロで対応できれば思ったのです。

回答No.5

Wendy02

#3 のWendy02です。

イメージは分かりました。しかし、既存のものを変更していくのは、かなりきついですね。

前の質問は締めてはいないようですから、こちら側は、私は、これまでにしておくつもりですが、しばらく、前の質問をオープンしておいてください。そこで考えてみます。

お礼

Wendy02さま

続けて考えていただけるとのご連絡、ありがとうございます。
その間、手作業で対応しつつ、自分なりにも考えてみます。
それでは、今回のこのページの問い合わせは依頼完了として閉じさせていただきます。ありがとうございました。

回答No.4

noname#140971

注意：無限ループからの脱出の仕掛けが不足！
注意：キーワードNot Foundの場合も脱出する必要あり！

回答No.2

noname#140971

Pause 1

は、エクセルの書き込みを確認するためのもので不要です。

FileExists（）は、説明不要でしょう。
FileRead（）ですが、これは部分的に読み込むのに適した関数です。
fso 等を静的変数として宣言していますので、コールされる都度に次行を戻します。

Data = FileRead("", True) と、閉じる引数に真を指定することでファイルを閉じます。
もちろん、最後まで読み込んだ場合は、自動的にクローズします。

　　Else
　　　　MsgBox "File not found!"
　　End If
　　Data = FileRead("", True)　<--- 欠落
End Sub

ということで、先程の回答に、閉じるコードが欠落していました。
この最後の行が無いと、エクセルを閉じるまでファイルは開きっぱなしになります。
ちょっと、注意を要するとことです。

Public Function FileExists(ByVal FileName As String) As Boolean
　　Dim fso As FileSystemObject

　　Set fso = New FileSystemObject
　　FileExists = fso.FileExists(FileName)
End Function

Public Function FileRead(ByVal FileName As String, Optional isStop As Boolean = False) As String
On Error GoTo Err_FileRead
　　Static isOpen As Boolean
　　Static fso　　As FileSystemObject
　　Static fil　　As File
　　Static txs　　As TextStream

　　If Not isOpen Then
　　　　isOpen = True
　　　　Set fso = New FileSystemObject
　　　　Set fil = fso.GetFile(FileName)
　　　　Set txs = fil.OpenAsTextStream(ForReading, TristateUseDefault)
　　End If
　　FileRead = txs.ReadLine
Exit_FileRead:
　　If Len(FileRead) = 0 Or isStop Then
　　　　isOpen = False
　　　　Set txs = Nothing
　　　　Set fil = Nothing
　　　　Set fso = Nothing
　　End If
　　Exit Function
Err_FileRead:
　　Resume Exit_FileRead
End Function

お礼

即答ありがとうございます。式も丁寧に書いて頂き、助かります。FileReadという関数を利用するのですか・・・。使ったことなかったので、書いて頂いた式を元に作業してみます。判らなければ、またここで検索、もしくは問い合わせさせて頂きます。どうもありがとうございました。

回答No.1

noname#140971

<Book1>
Ａ１
aaa___bbb___ccc
Ｂ１
aaa___bbb___ccc
Ｃ１
aaa___bbb___ccc

Private Sub CommandButton1_Click()
　　Dim isFound As Integer
　　Dim I　　　 As Integer
　　Dim N　　　 As Integer
　　Dim R　　　 As Integer
　　Dim Data　　As String
　　Dim Datas() As String

　　If FileExists("D:\Temp\Test.csv") Then
　　　　Do
　　　　　　Data = FileRead("D:\Temp\Test.csv")
　　　　　　isFound = isFound - (Data = "Ａ１")
　　　　　　If isFound = 1 Then
　　　　　　　　R = R + 1
　　　　　　　　Datas() = Split(Data, " ")
　　　　　　　　N = UBound(Datas())
　　　　　　　　For I = 0 To N
　　　　　　　　　　Cells(R, I + 1) = Datas(I)
　　　　　　　　Next I
　　　　　　ElseIf isFound = 2 Then
　　　　　　　　Exit Do
　　　　　　End If
　　　　　　Pause 1
　　　　Loop Until (0)
　　Else
　　　　MsgBox "File not found!"
　　End If
End Sub

ファイルの有無をチェックし、見つかれば無限ループに突入。
FileRead関数で、１行づつ呼び込む、
isFound関数で、キーワードをカウントする。
カウントが１であれば、データをスプリットしてエクセルに書き込む。
カウントが２であれば、何もしないでループから抜ける。
こういうルーチンで・・・。

ただし、キーワード行の書き込みをストップしたり、書き込み位置をキーワードとデータで変更したいならば多少工夫を。

ここでは、 FileExists()、FileRead（）という Microsoft Scripting Runtime を利用した関数を使っています。
長くなるので、後ほど補足します。