VBAでテキストからエクセルへ読み込む！

テキストデータをエクセルへ読み込みをする作業って多くないですか？

エクセルでデータを加工する。その元のファイルは、CSVやTXTファイルであることが多いです。

どこかのシステムからダウンロードをする。もしくは自動でされる。そして、そこから加工をして、月次や週次の会議で使う。

このルーチンってめちゃくちゃ面倒じゃありませんか？

CSVやtxtファイルも1つをコピー＆ペーストすれば良い。ならまだ軽いもので、それが何個もあったりしたらどうでしょうか？

そんなことで毎日1時間。ばからしいですよね？

とりあえずのとっかかりとなればと思います。

話したいこと

CSVの読み込みを行う方法を提示

読み込みにはたくさんの方法がある

自分なりに一番正しいと思ってる方法

VBAでテキストを読み込む方法

基本形


'=================================================================
'  目的：保存されているCSVファイルを取得してエクセルのシートに書き込みを実施。
'  注意：カンマでの分割を実施すると、分割不要の場所でも分割が起きる。
'----------------------------------------------------------------&gt;
'▼参照設定▼
'必要なし
'----------------------------------------------------------------&gt;
'▼動作▼
'　取り込み用のオブジェクトを作成。そのオブジェクトの作り方にADODB.Streamを宣言。
'　この方法ではUTF-8の文字コードに変換するため、上記宣言を実行。
'　改行で配列変数を作成して、その行数分ループを回す。
'　配列変数を次にまた作り、1行ずつ書き込みを実施する。
'----------------------------------------------------------------&gt;
'▼更新履歴▼
'
'=================================================================
Public Sub テキストをシートへ書き込む(ws As Worksheet, _
                                       MasterAdd As String, _
                                       argTextCharset As String)
Dim str1 As String, str2() As String, str3() As String
Dim LoopRun1 As Integer
Dim Row1 As Integer

'ADODB.Streamオブジェクトを生成（UTF-8という文字コードを使用したいから）
'通常のテキスト読み込みで進めると、”Shift_JIS”しか使えない。
'そして、参照設定を入れたくないので、Object型で宣言。
Dim adoSt As Object
Set adoSt = CreateObject("ADODB.Stream")

    '最終行の算出をしたいが、2であったなら1に+1をしたということ。つまりは、一番最初の処理ということになるので、今回は良しとする。
    Row1 = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
    If Row1 = 2 Then
        Row1 = 1
    End If

    With adoSt
        .charset = argTextCharset '文字化けを防ぐためにCharSetを合わせる。
        .Type = 2 '1:バイナリ、2:テキスト
        .Open
        .LoadFromFile MasterAdd 'ここはフルパス

        str1 = .readtext 'テキスト内を全部読み込む
'        str1 = .readtext(-2) '1行ずつ読み込む
    End With

    '※1行ずつ読み込んでいるのに、全部が引きずられてくる。
    str2 = Split(Replace(str1, """", ""), Chr(10)) '改行で、配列作成

        '改行で読み込まないと、すべてのテキストがまとめられてしまい1行ずつ読み取れなかった。
        'str2で配列を作成して、1行ずつ読み込む方法に切り替えた。

    For LoopRun1 = LBound(str2) To UBound(str2)
        If Empty = str2(LoopRun1) = False Then
            str3 = Split(str2(LoopRun1), ",")
            ws.Range(ws.Cells(Row1, 1), ws.Cells(Row1, UBound(str3) + 1)).Value = str3
        End If
        Row1 = Row1 + 1
    Next LoopRun1
End Sub

'=================================================================

' 目的：保存されているCSVファイルを取得してエクセルのシートに書き込みを実施。

' 注意：カンマでの分割を実施すると、分割不要の場所でも分割が起きる。

'---------------------------------------------------------------->

'▼参照設定▼

'必要なし

'---------------------------------------------------------------->

'▼動作▼

'　取り込み用のオブジェクトを作成。そのオブジェクトの作り方にADODB.Streamを宣言。

'　この方法ではUTF-8の文字コードに変換するため、上記宣言を実行。

'　改行で配列変数を作成して、その行数分ループを回す。

'　配列変数を次にまた作り、1行ずつ書き込みを実施する。

'---------------------------------------------------------------->

'▼更新履歴▼

'=================================================================

Public Sub テキストをシートへ書き込む(ws As Worksheet, _

MasterAdd As String, _

argTextCharset As String)

Dim str1 As String, str2() As String, str3() As String

Dim LoopRun1 As Integer

Dim Row1 As Integer

'ADODB.Streamオブジェクトを生成（UTF-8という文字コードを使用したいから）

'通常のテキスト読み込みで進めると、”Shift_JIS”しか使えない。

'そして、参照設定を入れたくないので、Object型で宣言。

Dim adoSt As Object

Set adoSt = CreateObject("ADODB.Stream")

'最終行の算出をしたいが、2であったなら1に+1をしたということ。つまりは、一番最初の処理ということになるので、今回は良しとする。

Row1 = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

If Row1 = 2 Then

Row1 = 1

End If

With adoSt

.charset = argTextCharset '文字化けを防ぐためにCharSetを合わせる。

.Type = 2 '1:バイナリ、2:テキスト

.Open

.LoadFromFile MasterAdd 'ここはフルパス

str1 = .readtext 'テキスト内を全部読み込む

' str1 = .readtext(-2) '1行ずつ読み込む

End With

'※1行ずつ読み込んでいるのに、全部が引きずられてくる。

str2 = Split(Replace(str1, """", ""), Chr(10)) '改行で、配列作成

'改行で読み込まないと、すべてのテキストがまとめられてしまい1行ずつ読み取れなかった。

'str2で配列を作成して、1行ずつ読み込む方法に切り替えた。

For LoopRun1 = LBound(str2) To UBound(str2)

If Empty = str2(LoopRun1) = False Then

str3 = Split(str2(LoopRun1), ",")

ws.Range(ws.Cells(Row1, 1), ws.Cells(Row1, UBound(str3) + 1)).Value = str3

End If

Row1 = Row1 + 1

Next LoopRun1

End Sub

これを使えば、テキストやCSVファイルを取り込むことができます。使ってみてください。

単体では使えないので、引数を渡すように作ってあげてください。

カンマで区切って起きた問題

CSVファイルの中には、金額を示すカラムが入っていることが多いが、「3,000」と記載されているため、「3」と「000」で別れてしまう。


    For LoopRun1 = LBound(str2) To UBound(str2)
        If Empty = str2(LoopRun1) = False Then
            str3 = Split(str2(LoopRun1), ",")
            ws.Range(ws.Cells(Row1, 1), ws.Cells(Row1, UBound(str3) + 1)).Value = str3
        End If
        Row1 = Row1 + 1
    Next LoopRun1

For LoopRun1 = LBound(str2) To UBound(str2)

If Empty = str2(LoopRun1) = False Then

str3 = Split(str2(LoopRun1), ",")

ws.Range(ws.Cells(Row1, 1), ws.Cells(Row1, UBound(str3) + 1)).Value = str3

End If

Row1 = Row1 + 1

Next LoopRun1

カンマで区切ったら逆に面倒？？

こういうのって、マジで面倒で、本当に大変なんですよね。せっかく作ったのに、作ったものはダメなのかい！みたいな・・・

そこで、自分なりに考えて区切る方法を試行錯誤しました。

独自の区切りを自分で作る

独自の区切りは注意が必要

書き込み時から仕込みが必要

できる限り一般的なCSVでも使えるように

「”,”」で区切るようにするのが一番効果的だった。

自分で区切りを作った結果をお伝えします。

独自の区切りのコードを示す

コピーして使ってください。


'=================================================================
'  目的：csvやtxtで、カンマの種類に応じてSplitさせるかさせないか判定し、
'　　　  エクセルシートへ書き込む。
'　　　　区切りのカンマとデータ内にある文字列のカンマの判別
'  注意：ワークシートは別で作成
'　　　　CSVやテキストには改行がエクセルとは違う。
'　　　　また、OSによっても違う
'　　　　Win：vbCRLF（キャリッジリターン＆ラインフィード）
'　　　　Mac：vbCR(キャリッジリターン）
'　　　　Linux：vbLF(ラインフィード）
'　　　　改行を設定するなら、使うOSに沿ったものを使用した方が良い。
'----------------------------------------------------------------&gt;
'▼参照設定▼
'なし
'----------------------------------------------------------------&gt;
'▼動作▼
'
'----------------------------------------------------------------&gt;
'▼更新履歴▼
'
'=================================================================
Private Sub カンマの種別に気を付けたcsvとtxtの書き出し(ws As Worksheet)
Dim LoopRun1 As Long, LoopRun2 As Long
Dim strLine As String

'カンマでsplitして格納
Dim arrLine As Variant
 
'変換文字の登録
Dim ConversionStr As String

'ダブルクォーテーション　カンマ　ダブルクォーテーションを格納する
ConversionStr = Chr(34) &amp; "," &amp; Chr(34)

'ファイルをオープン
Open TextRecAdd For Input As #1

LoopRun1 = 1
Do Until EOF(1)

    Line Input #1, strLine

    'ここでファンクションを入れて、実行させる
    '取得した文字をすべて変換する
    arrLine = Split(strLine, ConversionStr)

    For LoopRun2 = 0 To UBound(arrLine)

        'ダブルクォーテーションが左側の1文字だけに残っているか確認
        If Left(arrLine(LoopRun2), 1) = Chr(34) Then
            arrLine(LoopRun2) = Right(arrLine(LoopRun2), Len(arrLine(LoopRun2)) - 1)
        End If

        'ダブルクォーテーションが右側の1文字だけに残っているか確認
        If Right(arrLine(LoopRun2), 1) = Chr(34) Then
            arrLine(LoopRun2) = Left(arrLine(LoopRun2), Len(arrLine(LoopRun2)) - 1)
        End If

        '書き込みを実施する
        ws.Cells(LoopRun1, LoopRun2 + 1).Value = arrLine(LoopRun2)

   Next LoopRun2
    LoopRun1 = LoopRun1 + 1
Loop

Close #1

MsgBox "完了"

End Sub