おつかれさまです。

EXCEL超初心者マクロ(6)-特殊csvを取り込みたいとき-

2018年8月6日

改行など、いろいろなコードが混ざっているCSVをexcelにマクロで読み込むのは非常に面倒ですね。

前提条件はありますが、一つ例を上げたいと思います。

前提条件:
・CSVを直接EXCELで開くと必要な形で開ける。
・前ゼロが消えても問題ない。
※会社の社内ツールや、DBから抽出されたデータは、ダイレクトにEXCELで開くと問題はないが、excelで取込む(CSV)と改行やカンマの文字が弊害でデータがうまく取れないことがあります。

excelでCSVをダイレクトでオープンして、それをコピペすればそのまま取込めます。

Sample_6V10.xlsm

    MSG_FLG = MsgBox("変なCSV取込" & vbCrLf & "取込み処理実行OK?", vbYesNo)
    If MSG_FLG = vbNo Then
       Exit Sub
    End If

    mySheetName001 = "CSVDATAin"
    mySheetName002 = ActiveWorkbook.Name

   '### 全シートフィルタ解除サブプロシジー ###
    sheet_clear
    
   '### クリア処理 ***
    Sheets(mySheetName001).Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    
    Const cnsTITLE = "○データ、取込み処理"
    Const cnsFILTER = " csvファイル (*.csv),*.csv"
'
    With CreateObject("WScript.Shell")
        .CurrentDirectory = Worksheets("KANRI").Range("B2")
    End With

    vFILENAME = Application.GetOpenFilename(FileFilter:=cnsFILTER, title:=cnsTITLE)
    If VarType(vFILENAME) = vbBoolean Then
       MsgBox ("キャンセル")
       Exit Sub
    End If
    
    '### 自分Sheets
    Sheets(mySheetName001).Select '### 自分Sheets
    
    '### 取込み相手csv book OPEN copy
    Set strBookName = Workbooks.Open(vFILENAME)
    'Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select '### A1からCtrl+Shift+Endと同等
    Cells.Select '### シートの左上で全部選択するのと同等
    Selection.Copy

    '### 自分book 貼付け
    Windows(mySheetName002).Activate
    Range("A1").PasteSpecial Paste:=xlPasteValues
    Range("A1").Select

    '相手クローズ クリップモードメッセージ、保存メッセージ、飛ばす
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
    strBookName.Close savechanges:=False '@@@ 相手close
    Application.DisplayAlerts = True
    
    '### 自分にfocusを戻す
    Windows(mySheetName002).Activate '### 自分BOOK
 
    Set writeSheet = Nothing
    Set strBookName = Nothing

    MsgBox (" 取込み終了 ")


がんばりましょう。