배경

가끔 Excel의 일부 데이터를 CSV 파일로 하는 일이 있었습니다만,
그렇게 빈번하지 않았기 때문에 SAKURA 에디터로 붙여 → 탭 치환으로부터의 CSV 보존을 하고 있었습니다만,
정기적으로 가고 있다는 것을 깨달았으므로 매크로화하려고 했습니다.

만들고 싶은 기능

Excel에서 선택한 범위의 값을 CSV 파일로 만들고 싶습니다.



CSV 형식


품목
값


구분자
, (쉼표)

더블 코테이션
예

문자 코드
SJIS

개행 코드
CRLF


그런 다음 이름을 지정하고 저장

처음

Excel 선택 영역을 CSV 파일로 저장하면 그렇게 어색하지 않습니다.
아래 참고 사이트 님보다 조금 개조
참고 : htps : // / x x l ~ x x l. m / chi ps / v ba_198. HTML

Option Explicit

Sub csv_create_0()
    Dim sname, fname As String
    Dim rng As String

    'CSVファイル名
    fname = Application.GetSaveAsFilename(, "CSVファイル(*.csv),*.csv")

    '選択範囲のセルアドレス
    rng = Selection.Address
    'シート名
    sname = ActiveSheet.Name
    '新しいシートを追加し、選択範囲を値コピー
    Range(rng).Copy
    Worksheets.Add.Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

    '新しいブックを作成し、そこにシートを移動する
    ActiveSheet.Move
    '上書きのメッセージを表示させない
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=fname, FileFormat:=xlCSV
    '仮Excelは保存せずに閉じる
    ActiveWorkbook.Close savechanges:=False
    'メッセージ表示を戻す
    Application.DisplayAlerts = True
End Sub

단, 상기 매크로라면 더블 코테이션을 부여할 수 없다. . .
replace를 사용한 정규 표현의 치환 등 여러가지 시도했습니다만,
결국 CSV 포맷을 베타로 만들어 파일 저장 방법이 되었습니다. ↓

최종형

Sub csv_create()
    Dim reg, fname As String
    Dim rSelection As Object
    Dim r, f, v
    Dim fs, ts As Object
    Dim data As String
    Dim dr As Integer

    Set fs = CreateObject("Scripting.FileSystemObject") ' 書き込み用ファイルオブジェクト
    Set reg = CreateObject("VBScript.RegExp")           ' 正規表現用
    Set rSelection = Selection                          ' 選択範囲

    dr = 1      ' 初期行数
    data = ""   ' 書き込みデータ

    ' 選択セル範囲を１セルずつループ
    For Each r In rSelection

' 表示データを出力する
'        v = r.Value  ' 計算結果データ
        v = r.Text   ' 表示データ

        If dr <> r.Row Then
            ' 末尾,を削除
            data = Left(data, Len(data) - 1)
            ' 改行コード(CRLF)追加
            data = data & vbCrLf
            ' 次の行へ
            dr = r.Row
        End If

        ' ダブルコーテーション追加
        reg.Pattern = "^"
        v = reg.Replace(v, """")
        reg.Pattern = "$"
        v = reg.Replace(v, """")

        ' データ連結
        data = data & v & ","
    Next

    ' 末尾,を削除
    data = Left(data, Len(data) - 1)

    'CSV形式でファイル保存
    fname = Application.GetSaveAsFilename(, "CSVファイル(*.csv),*.csv")

    '// FileSystemObjectで新規ファイル作成
    Set ts = fs.CreateTextFile(fname, True, False)
    ts.WriteLine (data)
    ts.Close

End Sub

에러 체크라든지 특별히 하고 있지 않기 때문에 문제가 있을지도 모릅니다만,
우선 움직입니다.

Excel로 설정

고정 파일이 아닌 다양한 Excel 파일에서 매크로를 사용할 수 있도록 개인 매크로 북에 등록

매크로 저장

ALT+F11로 VBA 편집기 시작

바로 가기 키 설정

만든 매크로를 선택하고 옵션


다른 단축키와 쓰지 않도록

사이고에게

문자 코드 지정이나 개행 코드 지정 등도 그 중 대응하고 싶습니다.

추가

CSV 출력 데이터가 셀 표시 결과가 아니라 계산 결과가 되었기 때문에 수정

' 表示データを出力する
'        v = r.Value  ' 計算結果データ
        v = r.Text   ' 表示データ