ExcelにてCSV形式で保存するとき、指数表示のままで保管されてしまって困ります
以下のマクロを使用していて、問題が発生しました。
以下のようなシートを、配列に入れ、CSVファイルに入れるマクロです。ここで、B4セルに注目してください。中身は、「100000000000」ですが、セルには「1E+11」と指数表示となっています。12桁以上になると、指数表示なるようです。
配列に入れるまでは、以下の通り問題ありません。
このまま、CSV形式で保存すると、以下の通り、指数表示のまま、保管されてしまいます。
これを回避するための、マクロが、以下です。
Dim arr() As Variant
Private Sub test、シートを配列に入れ、csvファイルに出力()
' (ws, ByRef arr, Optional RejectRw = 0)
Call sheet_to_array("TEST", arr)
' (ByRef arr, FileName, Optional 種類)
Call array_to_csv_Excel(arr, ThisWorkbook.Path & "\sample5.csv")
End Sub
'*******
'* 二次元配列をCSVファイルに出力、高速化。20230912
'* https://excel-vba.work/2021/01/03/%E3%80%90vba%E3%80%91%E6%8C%87%E5%AE%9A%E3%81%97%E3%81%9F%E7%AF%84%E5%9B%B2%E3%82%92csv%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%81%B8%E5%87%BA%E5%8A%9B%E3%81%99%E3%82%8B/
'* arr:二次元配列。これが、csvファイルに出力される
'* FileName:csvファイル名、フルパス
Private Sub array_to_csv_Excel(ByRef arr As Variant, ByVal FileName As String)
Dim csvFile As String
' Dim targetRange As Range
Dim wb As Workbook
Dim fso As Object
'出力するCSVファイルを指定
csvFile = FileName
'CSVファイルへ出力する範囲を指定 ※例としてシート「sample」のセル「B2」から続く一連の範囲を指定
'Set targetRange = Worksheets("sample").Range("B2").CurrentRegion
'Set targetRange = arr
Set fso = CreateObject("Scripting.FileSystemObject")
'出力するCSVファイルが既に存在する場合は削除
If fso.FileExists(csvFile) Then
If IsBookOpened(csvFile) Then
Dim rc As Integer
rc = MsgBox("ファイルが開いています。" & vbCrLf & _
"はい:閉じて、削除して、処理を続けます。" & vbCrLf & _
"いいえ:処理を中断します", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
Dim FileNameOnly As String
FileNameOnly = fso.GetFileName(csvFile)
Windows(FileNameOnly).Close
Else
End
End If
End If
' ファイル削除
fso.DeleteFile csvFile
End If
'新規ブックを作成
Set wb = Workbooks.Add
' 配列をブックにコピー
' wb.Worksheets(1).Range("A1").Resize(UBound(arr), UBound(arr, 2)) = arr この行は削除
' =======================================================以下が今回追加
' 配列をブックにコピー
Dim ws As Worksheet
Set ws = wb.Worksheets(1)
ws.Range("A1").Resize(UBound(arr), UBound(arr, 2)) = arr
' 1列目全体の表示形式を文字列にするオブジェクト式
ws.Columns(1).NumberFormatLocal = "@"
' 指数表示から文字列に変換
Dim rw As Long
For rw = 2 To UBound(arr)
Cells(rw, 1).Value = Format(Cells(rw, 1))
Next rw
' =======================================================ここまでが今回追加
'新規ブックをCSVファイルとして出力
wb.SaveAs FileName:=csvFile, FileFormat:=xlCSV, Local:=True
' 「xlCSV」・・・・・文字コードは「Shift_JIS」となります。
' 「Local:=」に「True」を指定することで、「日付の形式」を「Excelの言語設定で指定されている言語(日本語と思います)」にします
'新規ブックを保存せずに閉じる
wb.Close SaveChanges:=False
'後片付け
Set fso = Nothing
End Sub
'*******
'* 「シート」を「配列」に入れるプロシージャ。20230707
'* SheetName:シート名前
'* myArray:出力される配列は、参照渡し。配列は、モジュールレベル変数としている。
'* RejectRw=1とすると頭の1行目を除いた表が、配列に入る。1行目の見出しが不要な場合に使用。
Sub sheet_to_array(ByVal SheetName As String, ByRef myArray As Variant, Optional RejectRw As Long = 0)
' 表を一気に変数にいれて処理
Dim Target As Range
Set Target = Worksheets(SheetName).UsedRange
With Target
If .Rows.Count > RejectRw And RejectRw > 0 Then
' 最初の行数(RejectRw)を除外する
Set Target = .Resize(.Rows.Count - RejectRw).Offset(RejectRw)
End If
End With
'Variant型の変数に値を一気に代入する
myArray = Target.Value
End Sub
Public Function IsBookOpened(ByVal FilePath As String) As Boolean
On Error Resume Next
Open FilePath For Append As #1
Close #1
If Err.Number > 0 Then
IsBookOpened = True
Else
IsBookOpened = False
End If
End Function
CSV形式で保管する直前のExcelが以下です。
以下のマクロで、A列の表示型式をを文字列に設定して、A列の値をセルごとに指数表示から文字列に変換しています。それで、無事、指数表示から文字列に変換されました。
' 1列目全体の表示形式を文字列にするオブジェクト式
ws.Columns(1).NumberFormatLocal = "@"
' 指数表示から文字列に変換
Dim rw As Long
For rw = 2 To UBound(arr)
Cells(rw, 1).Value = Format(Cells(rw, 1))
Next rw
CSVファイルも、以下の通り、問題なく作成されました。
12桁以上の数字を使用するときは、注意が必要です。
“ExcelにてCSV形式で保存するとき、指数表示のままで保管されてしまって困ります” に対して1件のコメントがあります。