CSVファイルのエクセル取込(VBA)で小数三位が消える!?

このQ&Aのポイント
  • CSVファイルのエクセル取り込み(VBA)において、小数点以下第三位まである数値がエクセルに取り込まれた段階で小数点以下第二位までに四捨五入される現象が発生しています。さらに、取り込んだセルの表示形式が通貨(¥マーク付き)になっています。この現象の原因と正しい小数三位までの取り込み方法を教えてください。
  • CSVファイルをエクセルで開くと正確に小数三位までの数値が表示されますが、VBAを使ってCSVファイルをエクセルに取り込む際に小数点以下第三位が消える現象が起きています。また、取り込んだセルの表示形式も通貨(¥マーク付き)になっています。この問題を解決する方法を教えてください。
  • VBAを使用してCSVファイルをエクセルに取り込む際に、小数点以下第三位まである数値が小数点以下第二位までに四捨五入されてしまう問題が発生しています。また、取り込んだセルの表示形式が通貨(¥マーク付き)になっています。この問題の原因と解決策を教えてください。
回答を見る
  • ベストアンサー

CSVファイルのエクセル取込(VBA)で小数三位が消える!?

エクセルにCSVファイルから読み取りをするVBAで下記のように記述しています。 Sub CSV読取り Dim FName As Variant FName = Application.GetOpenFilename(FileFilter:="CSVファイル (*.csv), *.csv") Open FName For Input As #1 For i = 1 To 400 Input #1, Columni ThisWorkbook.Sheets("CSV取得").Cells(i, "E").Value = Columni Next i Close #1 End Sub これでほとんどのデータ(数値や文字列の400件)をうまく読み取るのですが、どういう訳かデータが小数点以下第三位まである数値の場合、エクセルに取り込まれた段階で小数点以下第二位までに四捨五入されてしまうようです。 そのうえ、エクセルのセルの表示形式がそこだけ通貨(¥マーク付き)になっています。 なぜでしょうか? またどうしたら正しく小数3位まで読み取れるのでしょうか? CSVファイルをエクセル単純にエクセルで開けばちゃんと小数三位まであるのですが、データが横一列にカンマ区切り400件あるので256列しかないエクセルではすべてとりこめません。(だから上記のマクロで縦に変換してとりこんでいるのですが) 非常に困っています。

質問者が選んだベストアンサー

  • ベストアンサー
  • wakky_tom
  • ベストアンサー率40% (20/50)
回答No.2

追記です。 csvファイルがすべて数値だと思っていたもので・・・ Dim Columni As String で回避することは出来ると思うのですが、さんが求めているものはもっと高いレベルのような気がしてきました。 すみませんでした。。。

AQUALINE
質問者

補足

> csvファイルがすべて数値だと思っていたもので・・・ 文字(全角および半角英字)と整数と小数です。 Dim Columni As String で十分問題は解決しました。 小数も正しく表示されましたし、空白がゼロにかわったり。文字が消えることも今のところ有りませんでした。 これでいいと思うのですが、何か問題が起きる可能性があるのでしょうか? 昨日からやっていますがまだ問題はおきていません。 ご教示いただけると幸いです。

その他の回答 (3)

  • wakky_tom
  • ベストアンサー率40% (20/50)
回答No.4

こんばんは Stringは一応、文字列、数値とも対応できるので大丈夫だと思います。 お役に立てて幸いです。

AQUALINE
質問者

お礼

ありがとうございました。 お礼が遅くなり申し訳有りませんでした。 本当に助かりました。

  • wakky_tom
  • ベストアンサー率40% (20/50)
回答No.3

AQUALINEさんのお名前が抜けてしまいました。 失礼しました。

  • wakky_tom
  • ベストアンサー率40% (20/50)
回答No.1

こんにちは 原因究明には至っておりませんが・・・ Dim Columni As Double を追加してはいかがでしょうか? 私も実際試しましたが、AQUALINEのおっしゃるとおりの結果になりました。 不思議ですねぇ。

AQUALINE
質問者

補足

早速ありがとうございました。 ためしたところ小数点については解決しました。 しかし今度は空白データおよび半角1文字だけのデータ「E」がすべて「0」に置き換わってしまいました。

関連するQ&A

  • Excelマクロでフォルダ内のCSVファイルを一括で読み込ませるには?

    Excelファイルと同階層にあるCSVファイルを読み込ませるマクロを作ってみたのですが、正常に動作しません。 アドバイスいただければ幸いです。 Excel2003を使用しています。 Sub 同階層フォルダ内のCSV読込_Click() Dim fname As String 'ファイル名 Dim pathname As String 'パス名 Dim dat(1 To 4) As Variant '読み込んだデータ Dim rr As Long '対象行番号 Dim i As Integer '列のオフセット Dim j As Integer 'ファイル識別番号のオフセット '同階層フォルダ内のCSVファイルを参照 pathname = ".\*.csv" fname = Dir(pathname, vbNormal) 'データを挿入する行番号 rr = 2 '該当するファイルがある間 Do While fname <> "" j = 0 j = j + 1 'ファイルを開く Open fname For Input As #j 'ファイルの終端まで Do Until EOF(j) 'データを取得 Input #j, dat(1), dat(2), dat(3), dat(4) '読み込んだデータをセルに出力 For i = 1 To 4 Cells(rr, i).Value = dat(i) Next '行番号を更新 rr = rr + 1 Loop Close #j 'フォルダ内の次のファイルを検索 fname = Dir() Loop End Sub

  • エクセルVBAでボタンを割り当てて、そこに入力行数とCSV形式出力をおこなうように記述したい。

    エクセルのVBAでエクセルの入力データをCSVに出力するVBAを書こうとしておりますが、2点ほどわかりません。 まず、入力行数を調べたいのですが、A列で入力があるところまでを個数としたいのですがどのように求めるかわかりません。 あと、データをCSV形式でファイルに落としたいのですがどうすればよいのでしょうか? Dim fp As Integer Dim fname As String dim num as integer num = 入力数(たとえば、a列に入力がある行数など)  msgbox("入力行数=" & cstr(num) & "です。") fname = "test.csv" fp = FreeFile Open fname For Output As #fp CSV形式で出力する Close #fp

  • VBAで、ExcelシートにCSVファイルのデータを取り込みたいのです

    VBAで、ExcelシートにCSVファイルのデータを取り込みたいのですが、 1行目しか取り込めません。 取り込む項目数は32個です。 以下のコードでは、Excelシートの1行目のみ取り込みができますが、 1行目32列目のセルには、2行目のA列に表示されるべきデータも表示されます。 2行目以下は取り込みできていません。 Sub CSV取込() Dim OpenFileName As String Dim MyString As String Dim MyVar As Variant Dim i As Long, j As Long OpenFileName = Application.GetOpenFilename("CSVファイル,*.csv") If OpenFileName = "False" Then MsgBox "キャンセルされました。" Else Open OpenFileName For Input Access Read As #1 i = 1 While Not EOF(1) Line Input #1, MyString MyVar = Split(MyString, ",") If MyVar(0) <> "" Then For j = 0 To 31 ThisWorkbook.ActiveSheet.Cells(i + 10, j + 1) = MyVar(j) Next j i = i + 1 End If Wend Close #1 End If End Sub おそらく、改行が判別できないためかと思いますが、 どこが間違っているのかがわかりません。 アドバイスをよろしくお願いします。

  • excel vbaで複数のcsvファイルの読み込み

    100シート分のcsvファイルのデーターを一つずつ読み込んでexcelにコピーして使用してますが莫大な時間がかかって困ってます。 vbaを使用して作業を簡素化出来る事は出来ないでしょうか? ------------------------------------------ ※ csvの概要 excelで1枚のcsvファイルを開くとA列の11行目から65536行まで数値データがあります。 ※ vbaできたらよいなと思う仕様 そこで、複数のcsvファイルを選択して読み込むとCSV_データと言うSeetのA列の10行目から1枚目のcsvファイル、B列の10行目から2枚目のcsvファイルと言う風に選択した分のcsvを列に続けて数値データを貼り付けしてくれるvbaをご教授していただけると大変助かります。 不躾で申し訳ございませんが宜しくお願い致します。 excel2003 ------------------------------------------

  • csvファイルをvbaで読み込みたいけど文字化け

    エクセル2007です。 http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_020.html を参考にcsvファイルをシートに書きだそうとしてるのですが、 リンク先のサンプルコードのの Input #intFF, X(1), X(2), X(3), X(4), X(5) の部分で、 ファイルにこれ以上データがありません。(Error 62) と言うエラーになってしまいます。 元のcsvファイルは、サンプル通り5項目(A列~E列)にしてみましたが エラーになってしまいます。 なので、 http://officetanaka.net/excel/vba/error/execution_error/error_62.htm を参考に、 Sub Sample1() Dim buf As String Open "C:\Users\test\Downloads\test.csv" For Input As #1 Do Until EOF(1) Line Input #1, buf Loop Line Input #1, buf Close #1 End Sub としてみたところ、やっぱり同じエラーになって、 ?bufをしたら、 ヨS_蘰 gqが返ってきました。 文字化けしてるようですが、フィールド(1行目)に日本語が入っていますが それが原因なのでしょうか? 日本語が入ってるcsvファイルをvbaで書き出す事は不可能なのか教えてください。

  • VBA:2つのCSVファイルを開きたいです。

    エクセル2010のVBAにてCSVファイルを開き結合させるプログラムを組もうとしているのですが、2つ目のCSVファイルを開こうとすると、何故かエラーが出てしまいます。 -------------------------------------------------------------------------------- 1つ目 Sub mobile_FileSearch(Path As String) 'test.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call mobile_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "test.csv" Then Workbooks.Open ("test.csv") End If Next File End Sub ---------------------------------------------------------------------------- 2つ目 Sub local_FileSearch(Path As String) 'bbb.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call local_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "bbb.csv" Then Workbooks.Open ("bbb.csv")'←ここでエラー End If Next File End Sub ------------------------------------------------------------------------ まったく同じプログラムで、csvファイル名だけ変えただけで実行時エラー1004が出てしまいます。 一体全体何が問題なのでしょうか?

  • VisualBasicからcsvファイルを読み込む

    VisualBasicからcsvファイルを以下のようなプログラムで読み込んでいます。 Open ファイルパス For Input Shared As #1 Do Until EOF(1): Input #1, A(i), B(i): i = i + 1: DoEvents: Loop Close #1 n行2列のcsvファイルとn行3列のcsvファイルを読み込んだ時に A(2)にセルB1、B(2)にセルB2の値を代入したいです。 現状だとn行3列のcsvファイルを読み込んだ時に A(2)にはセルA3の値が入ってしまいます。 n行3列の3列目のデータは無視したいです。

  • エクセルVBA CSVファイル出力について

    エクセルVBAでCSVファイル出力マクロを作成しています。 本を参考にして作成したのですが、日付のセルで 2007/7/22 8:29:45と記入させているのが #2007-07-22 08:29:45#と言う形で出力 されてしまいます。 そのまま「2007/7/22 8:29:45」と出力させるには どのようにしたらいいのでしょうか? 出力したデーターを基にアクセスに取り込んでデーター ベースにしようと思っているのですが、「#」がある ため、そのまま、時刻関数で取り込めないもので 困っています。 コードは以下のように書いてあります。 Sub WriteCsv() Dim myTxtFile As String, myFNo As Integer Dim myLastRow As Long, i As Long Dim ShName As String Application.ScreenUpdating = False ShName = ActiveSheet.Name myTxtFile = ActiveWorkbook.Path & "\" & ShName & ".csv" myLastRow = Range("A1").CurrentRegion.Rows.Count myFNo = FreeFile Open myTxtFile For Output As #myFNo For i = 1 To myLastRow Write #myFNo, Cells(i, 1), Cells(i, 2), Cells(i, 3) Next Close #myFNo MsgBox "このシートを元に「" & ShName & ".csv」を作成しました" End Sub 宜しくお願いいたします。

  • エクセル2003 CSVファイルの取り込み速度向上について

    CSVファイルを取り込んで、必要なデーターを処理しているのですが、 CSVのファイルのデーター取り込み速度を上げるのを、皆様のご意見 を参考にさせていただきたいと思います。 VBAの構成は以下の構成でつくりました (1)ファイルの選択 ↓ (2)CSVファイルの中身の確認 ↓ (3)CSVファイルの取り込み、エクセルのセルに展開 と言う構成になっております。 で、(3)の所が結構時間を要するのですが、処理が早くなるコードの 書き方とかありましたら、参考にさせていただきたいなぁ~と 思っております。自分的に思っているのは(2)の所は時間をそれほど 要しないので、取り込みよりエクセルのセル展開の処理の方で時間 をくっているように感じるので、その辺を上手くできないのかな? とか思ったりしてます。まだ、VBAを勉強し始めて半年足らずなので 皆さんの意見などを参考にさせていただけましたと思っております。 宜しくお願いいたします。 実際のコードは以下に記します。 __________________________________ Option Explicit Option Base 1 Dim myTxtFile As String Dim myBuf(45) As String Dim i As Integer, j As Integer Dim mytext As String, mymsg As String Dim myselect As Integer Dim FirstDay As String, EndDay As String Dim n As String _______________________________ Private Sub ReadTxt() Application.ScreenUpdating = False n = 1 Open myTxtFile For Input As #1 Do Until EOF(1) Input #1, myBuf(1), myBuf(2), myBuf(3), myBuf(4), _ myBuf(5), myBuf(6), myBuf(7), myBuf(8), myBuf(9), _ myBuf(10), myBuf(11), myBuf(12), myBuf(13), myBuf(14), _ myBuf(15), myBuf(16), myBuf(17), myBuf(18), myBuf(19), _ myBuf(20), myBuf(21), myBuf(22), myBuf(23), myBuf(24), _ myBuf(25), myBuf(26), myBuf(27), myBuf(28), myBuf(29), _ myBuf(30), myBuf(31), myBuf(32), myBuf(33), myBuf(34), _ myBuf(35), myBuf(36), myBuf(37), myBuf(38), myBuf(39), _ myBuf(40), myBuf(41), myBuf(42), myBuf(43), myBuf(44), myBuf(45) If n = 2 Then FirstDay = myBuf(1) End If n = n + 1 EndDay = myBuf(1) Loop EndDay = myBuf(1) mymsg = FirstDay & "~" & EndDay myselect = MsgBox(mymsg, vbYesNo + vbInformation) If myselect = vbNo Then Close #1 Exit Sub End If Close #1 Open myTxtFile For Input As #1 Do Until EOF(1) Input #1, myBuf(1), myBuf(2), myBuf(3), myBuf(4), _ myBuf(5), myBuf(6), myBuf(7), myBuf(8), myBuf(9), _ myBuf(10), myBuf(11), myBuf(12), myBuf(13), myBuf(14), _ myBuf(15), myBuf(16), myBuf(17), myBuf(18), myBuf(19), _ myBuf(20), myBuf(21), myBuf(22), myBuf(23), myBuf(24), _ myBuf(25), myBuf(26), myBuf(27), myBuf(28), myBuf(29), _ myBuf(30), myBuf(31), myBuf(32), myBuf(33), myBuf(34), _ myBuf(35), myBuf(36), myBuf(37), myBuf(38), myBuf(39), _ myBuf(40), myBuf(41), myBuf(42), myBuf(43), myBuf(44), myBuf(45) 'データをセルに展開する i = i + 1 For j = 1 To 45 Cells(i, j) = myBuf(j) Next j Loop Close #1 Application.ScreenUpdating = True End Sub _________________________________ Sub myOpenDialog() myTxtFile = Application.GetOpenFilename("CSV ファイル(*.csv),*.csv") Call ReadTxt End Sub

  • VBAでCSVファイルを読み込もうとしていますが、

    VBAでCSVファイルを読み込もうとしていますが、 「ファイルが見つかりません」とエラーが表示されます。 どのように対処していいのかわかりません。 教えてくください。 Sub readCsv() Dim csvFile As String Dim ch As Integer Dim csvStr As String Dim str() As String Dim i As Integer Set ShellApp = CreateObject("Shell.Application") Set oFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1) targetFolder = oFolder.Items.Item.Path Set fso = CreateObject("Scripting.FileSystemObject") Set fileList = fso.GetFolder(targetFolder).Files For Each file In fileList csvFile = file.Name ch = FreeFile Open csvFile For Input As #ch i = 1 Do While Not EOF(1) Line Input #ch, csvStr Close #ch str = Split(csvStr, ",") Range(Cells(i, 1), Cells(i, UBound(str) + 1)) = str i = i + 1 Loop Next End Sub

専門家に質問してみよう