選択範囲をcsv出力するExcelマクロ(UTF-8,SJIS)

Excelは、保存の形式をcsvにすると、csvファイルをエクスポートすることができます。ただ、列をカンマで囲んだり、export時にちょっとした加工を行うのは難しいですよね。

そこで、データをExcelで管理しつつ、それらをcsvとして出力するときには好きな個所を選択し、その部分のみを書き出せるようなマクロは重宝します。

結構いろんな仕事で使うことが多いので、自分用としても置いておこうと思います。使いたい方は自由にお使いください。

 

クラスモジュール「UTF8CSVWriter」

  Private name

  '
  Private Sub Class_Initialize()
    name = "UTF8CSVWriter"
  End Sub

  ' Save for UTF-8
  Public Sub WriteRange(fromRange, toRange, fileName)

    On Error Resume Next


    Dim txt As Object
    Set txt = CreateObject("ADODB.Stream")

    'Set data type to save TEXT.
    txt.Type = adTypeText
    'Set char code to UTF-8
    txt.Charset = "UTF-8"

    txt.LineSeparator = adCRLF


    txt.Open


    'Set range
    Set r = Range(fromRange, toRange)

    Dim rowNo As Integer
    Dim colNo As Integer
    Dim colNoMax As Integer

    rowNo = Range(fromRange).Row
    colNoMax = Range(toRange).Column


    For Each r2 In r

        colNo = r2.Column

        If rowNo <> r2.Row Then
            rowNo = r2.Row
        End If

        'Chr(34) is double quotes
        txt.WriteText Chr(34)
        txt.WriteText r2.Value
        txt.WriteText Chr(34)

        If colNoMax = r2.Column Then

            txt.WriteText vbNewLine
        Else

            'Chr(44) is comma
            txt.WriteText Chr(44)

        End If

    Next r2

    txt.SaveToFile fileName, 2
    txt.Close
    Set txt = Nothing



  End Sub

 

それを呼び出す側

Sub output_Click()


    Dim fileName As String
    fileName = Range("B1").Value & ".csv"


    thisPath = ActiveWorkbook.Path

    Dim fw: Set fw = New UTF8CSVWriter

    Call fw.WriteRange(Selection(1).Address, Selection(Selection.Count).Address, thisPath & "" & fileName)

End Sub

 

 

例はUTF-8ですが、UTF8CSVWriterの文字コード指定部分をSJISにすると、SJISでcsvファイルが書けます。



こんな記事も関係あるかも。読んでみてね。

コメントを残す

サブコンテンツ

このページの先頭へ