Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
csv取り込み
投稿日時: 19/07/03 16:00:21
投稿者: moug_tahara

お世話になります。
CSVを、Excelに取り込みたいのですが、CSVの途中に改行が入っており、上手くいきません。
具体的にはUSBメモリ等のデバイスのシリアル番号ですが、取得元のUSBメモリの情報に改行がついてしまっている為、元データを修正する事はできず、データも手で修正するには少し量が多く厳しいので、取得する側で工夫が必要です。
以下のように、eeeと,FFFFの間は改行ではなく、1行で取り込みたいのですが、方法はありますでしょうか。
 
元のCSV例
111,AAA,aaa,BBBB,bbbb
222,CCC,ccc,DDDD,dddd
333,EEE,eee
,FFFF,ffff
444,GGG,ggg,HHHH,hhhh

投稿日時: 19/07/03 16:12:21
投稿者: moug_tahara

申し訳ありません。コードを掲載していませんでした。
 
sub リムーバブルCSV()
  Dim Filepath As String
  Dim SearchFName As String
  Dim NewFile As String
  Dim 処理名 As String
   
  処理名 = "リムーバブル"
  Worksheets(処理名).Activate
  Worksheets(処理名).Cells.Clear
   
  SearchFName = "C:\Secu\log\" & 処理名
 
  'フォルダ内、最新ファイル取得
  NewFile = NewFName(SearchFName)
  Filepath = SearchFName & NewFile
  Debug.Print Filepath
   
  Dim WS As Worksheet
  Call ReadCSV.ReadCSV(Filepath:=Filepath, _
                       TextColumns:="23,24,25,29,30,31", _
                       OutputWorksheet:=Worksheets(処理名), _
                       OutputColumn:=1, _
                       OutputRow:=1)
   
 
End sub
Function NewFName(RootFolder)
'Dim RootFolder As String
Dim Filename As String
Dim Filename2 As String
 
'ファイルが一つしかなかった場合
On Error Resume Next
 
    Filename = Dir(RootFolder & "\*.*", vbNormal)
    Filename2 = Dir()
    Do While Filename <> ""
        If FileDateTime(RootFolder & "\" & Filename2) < FileDateTime(RootFolder & "\" & Filename) Then
            Filename2 = Filename
        End If
        Filename = Dir()
    Loop
 
    NewFName = Filename2
End Function

回答
投稿日時: 19/07/03 16:29:46
投稿者: Suzu

意味のないコードの全体を提示されてもしょうがないです。
 
取り込み自体は、多分、
 

引用:
Call ReadCSV.ReadCSV(Filepath:=Filepath, _
                       TextColumns:="23,24,25,29,30,31", _
                       OutputWorksheet:=Worksheets(処理名), _
                       OutputColumn:=1, _
                       OutputRow:=1)

 
ここで行っているのですよね?
 
その肝心の ReadCSV.ReadCSV の内容は提示頂けないのですか?
 
仮に
【経理・会計事務所向けエクセルスピードアップ講座】
『【超簡単】エクセルVBAでCSVファイルを読み込むマクロ』
https://www.excelspeedup.com/readcsv/
 
なのだとすれば
 
LineEndingCode を 指定すれば良いのでは?

回答
投稿日時: 19/07/03 22:48:06
投稿者: simple

>CSVの途中に改行が入っており、上手くいきません。
正規表現による置換が可能なテキストエディター(例:秀丸エディタ)を使って、
"\n," を
","に置換することを考えてはどうでしょうか。
勿論、VBAだけでそれをすることも可能ですが、上記の手段を採れるなら、
それが一番簡単ですね。

投稿日時: 19/07/04 15:28:42
投稿者: moug_tahara

申し訳ございません。
ReadCSV.ReadCSVについては、ご提示のサイトに記載のものを参照しました。
  
https://www.excelspeedup.com/readcsv/
 
毎日の事なので、手動での編集はなるべく避けたいのですが、
LineEndingCodeを指定しても何も結果が変わらず、
中身をもう少し確認してみます。

回答
投稿日時: 19/07/04 21:44:02
投稿者: simple

まず、確認したいのは、
改行文字が入ってしまっているのは、
項目の終わり(すなわちカンマの前)という前提でよいか

という点です。
 
もし、それ以外のパターンがあるなら、それを最初にしっかり示してもらわないといけません。
 
もし、そのパターンしかないのであれば、

・CSVファイルから文字列をすべて読み込み
・改行 & "," を ","に置換し、
・それを新たなCSVファイルに書き込めば、
通常のスタイルのCSVに戻ります。
あとは、既にある手法でOKのはずです。
 
前提について明示してもらえますか?

回答
投稿日時: 19/07/04 23:32:09
投稿者: simple

えーと、それ以外の任意のところで改行が入っている、そんなデータは勘弁してもらって、
示されたケースについてだけ方針を書いておきます。
 
(1)テキストファイルを一括して文字列変数に読み込み、
(2)vbCrLf & "," を "," にReplaceします。
(3)新しいテキストリームを開いて、その文字列を書き込みます。
これで通常のCSVファイルになります。
 
FileSystemObjectを使うのがよいと思います。
下記のサイトを参考にコードにして下さい。
 
(1)については、
TextStreamオブジェクト - ReadAllメソッド
http://officetanaka.net/excel/vba/filesystemobject/textstream07.htm
 
(2)は普通にReplace関数でできますね。
 
(3)については、
FSOのCreateTextFileメソッド
http://officetanaka.net/excel/vba/filesystemobject/filesystemobject06.htm
TextStreamオブジェクト - Writeメソッド
http://officetanaka.net/excel/vba/filesystemobject/textstream11.htm
を参考に。
 
# とりあえずここまでとします。

投稿日時: 19/07/05 09:15:17
投稿者: moug_tahara

お世話になります。
手前にCRが入っていたので、Replace(buf, vbCr & vbCrLf & ",", ",")としましたが、
上手く改行を取り除く事ができました。ありがとうございます。
 
Sub test78()
    Dim FSO As Object, buf As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''txtの全ての文字を読み込んで表示します
    With FSO.GetFile("c:\test\デバイス一覧.csv").OpenAsTextStream
        buf = .ReadAll
        buf = Replace(buf, vbCr & vbCrLf & ",", ",")
        Debug.Print buf
        .Close
    End With
    Set FSO = Nothing
     
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With FSO.CreateTextFile("c:\test\デバイス一覧2.csv.csv")
        .WriteLine buf
        .Close
    End With
    Set FSO = Nothing
End Sub