食っちゃ寝システムができるまで

「食っちゃ寝システム」ができるまでの、棚卸&備忘録です。

VBA使用頻度の高いコード(6):エクセルシートのCSV出力

f:id:taikobox:20181209173448p:plain

エクセルシートのCSV出力

エクセルシートのCSV出力用コード

ここコードはリストから一部の列をTEMPシートに整理しなおして出力するように作っています。

流れとしては、

事前に貼付用CSVファイル作成

⇒元のシートから必要なデータ範囲(ここでは"B9:K2000")をコピー

⇒「TEMP」シートに内容貼付け

⇒「TEMP」の内容を事前に作成したCSVに貼付け

⇒完了


===============================

Sub CSV書出し()
Dim FileN, DateValue As String
Dim re As Integer

DateValue = Date
FileN = Application.GetSaveAsFilename(InitialFileName:="GoogleMap出力用_" & Range("C6") & "_" & Format(DateValue, "yyyymmddhhnn") & "_1" & ".csv", _
FileFilter:="CSV ファイル (*.csv), *.csv")


'既にある場合の上書き
If FileN <> "False" Then
If Dir(FileN) <> "" Then
re = MsgBox(FileN & String(2, vbLf) & _
"は、存在します。 上書きしますか?", vbYesNo)
'開いているかのチェック
On Error Resume Next
Open FileN For Append As #1
Close #1
If Err.Number > 0 Then
MsgBox "すでに開かれています、閉じてやり直してください"
Exit Sub
End If

If re = vbYes Then Kill FileN
Else
End If
Application.ScreenUpdating = False
Sheets("TEMP").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("画像リスト").Select
'GoogleMyMap1レイヤ2000までなので1990レコードを上限にしています。それ以上は別ファイルで作業して下さい
Range("B9:K2000").Select
Selection.Copy
Sheets("TEMP").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Copy
ActiveWorkbook.SaveAs FileName:=FileN, FileFormat:=xlCSV, Local:=True
ActiveWorkbook.Close SaveChanges:=False
MsgBox "CSVファイルで書き出しました。", vbInformation
End If
Sheets("画像リスト").Select
Application.ScreenUpdating = True
End Sub

===============================