• ベストアンサー

ファイルを読み込むとデータが変わるのはなぜ？

Excel VBAでOpenメソッドを使ってtxtファイルを読み込みセルに表示させると、 txtファイルに書いてある値と違う値が表示されてしまいます。読ませたデータは、106303314215443605050000,05D0NPZHRPF0,000CE5155098です。これが 1.06303E+23,05D0NPZHRPF0,000CE5155098となってしまいます。原因がわからず困っています。ソースは次の通りです。 '開くファイル名を取得 getF_name = Application.GetOpenFilename("テキストファイル(*.txt),*.txt") If getF_name = False Then Exit Sub End If 'i = Worksheets("管理台帳2").Range("B65536").End(xlUp).Row i = 3 'ファイルを開いて、データを読み込む Open getF_name For Input As #1 Do Until EOF(1) Input #1, myBuf1, myBuf2, myBuf3 If myBuf2 = myBuf3 Then Worksheets("管理台帳2").Cells(i + 1, 2).Value = myBuf1 Else Worksheets("管理台帳2").Cells(i + 1, 3).Value = myBuf1 Worksheets("管理台帳2").Cells(i + 1, 4).Value = myBuf2 Worksheets("管理台帳2").Cells(i + 1, 5).Value = myBuf3 End If i = i + 1 Loop '開いたファイルを閉じる Close #1 'セルをデータの幅に調整 Worksheets("管理台帳2").Select Columns("A:A").EntireColumn.AutoFit Columns("B:B").EntireColumn.AutoFit Columns("C:C").EntireColumn.AutoFit どなたか教えて頂けませんか？宜しくお願いいたします。

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

  • ベストアンサー
  • BlueRay
  • ベストアンサー率45% (204/453)
回答No.2

えっと、まずは回答ではないですけどカテゴリはあってますか？ExcelVBAの質問に見えるのですが… ExcelVBAの質問であれば、「Microsoftアプリケーション」の方で質問されるのがいいと思いますよ。 えっと、"106303314215443605050000"が"1.06303E+23"と表示されるのを直したいと言うことですよね？ "106303314215443605050000"は数値データ？それとも文字データ？ 数値データなら、桁数分の書式設定をしてやれば良いでしょう。 書式設定→"000000000000000000000000" 文字データなら、書式設定を「文字列」にするか。もしくは、以下の様にすれば出来ると思います。 ～.Value = "'" & Buf1 にすれば、全て表示されます。 如何でしょうか。

senzin
質問者

お礼

すみません。入力した後カテゴリが間違ってるのに気づいたのですが、削除できなくて・・・・ 教えていただいた方法で解決しました。有難うございます。 でも、どうして　’を入れるとちゃんと表示されるのでしょうか？理由も教えていただけると勉強になるのですが・・ お願いできませんか？

その他の回答 (2)

  • BlueRay
  • ベストアンサー率45% (204/453)
回答No.3

セルの書式設定で表示形式のデフォルトは「標準」になっています。 標準状態で入力された文字列が全て数字の場合は、数値と判断され数字以外の文字列を含む場合は只の文字列と判断されます。 そこで、入力された数字だけの文字列を数値として判断しないようにする為に、「'」と言うのが準備されています。 ですので、数字だけで文字列として表示する場合は先頭に「'」を付ける物だと思ってください。

senzin
質問者

お礼

有難うございます。たいへん勉強になりました。

  • guruguru2
  • ベストアンサー率29% (39/132)
回答No.1

セルの幅が小さくて１６進数表示になっているわけではないのですよね？（この場合はセル幅を広げればいいだけですけど…。） 後は、 「Open getF_name For Input As #1 」のところを 「Open getF_name For binary As #1」で開いて、 「line input」で読み込んでみるとか？

senzin
質問者

お礼

こんな方法もあったんですね。勉強になりました。 有難うございます。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Microsoft ASP

関連するQ&A

  • VBAデータ元から新規ブックに出力

    現在のブック内に出力されるとメモリの都合上時間がかかりすぎますそこで新規ブック１個に出力する構文を教えていただきたいのですが、宜しくお願いします。 Sub １１１１() Dim c As Range Dim i As Integer, LastRow As Long Dim NewSheetName As String, MatchFlag As Boolean Application.ScreenUpdating = False NewSheetName = "" With Sheets("データ元") For Each c In .Range(.Cells(3, "B"), .Cells(Rows.Count, "B").End(xlUp)) MatchFlag = False If NewSheetName <> Year(c.Value2) & "年" & Month(c.Value2) & "月" Then NewSheetName = Year(c.Value2) & "年" & Month(c.Value2) & "月" For i = 1 To Worksheets.Count If Sheets(i).Name = NewSheetName Then Sheets(i).Cells.ClearContents MatchFlag = True Exit For End If Next i If MatchFlag = False Then Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = NewSheetName End If End If LastRow = Sheets(NewSheetName).Cells(Rows.Count, "A").End(xlUp).Row Sheets(NewSheetName).Cells(LastRow + 1, "A").Resize(1, 6).Value = .Cells(c.Row, "A").Resize(1, 6).Value Sheets(NewSheetName).Columns("A:F").EntireColumn.AutoFit '↑A列からF列まで自動幅調整してます Next .Activate End With Application.ScreenUpdating = True MsgBox "終了しました", vbInformation End Sub

  • EXCELでのリスト作成について

    このサイトでこのようなマクロを教えてもらいました。 そこでこれはシートの左側からリストシートに表示していくのですが、右側からリストにしていく方法はないでしょうか？ よろしくお願いします。 ------------------------- Sub テスト() ActiveWindow.WindowState = xlNormal Dim i As Integer, r As Range With Worksheets("リスト") .Hyperlinks.Delete .Range("B4:B65536").ClearContents For i = 2 To Worksheets.Count Set r = .Cells(((i - 2) Mod 20) + 4, 2 + Int((i - 2) / 20)) r.Value = Worksheets(i).Name .Hyperlinks.Add Anchor:=r, Address:="", _ SubAddress:=Worksheets(i).Name & "!A1" Next i End With Columns("B:B").EntireColumn.AutoFit End Sub -------------------------

  • エクセルで複数のシートに罫線を引くマクロを教えてください。

    エクセルで複数のシートに罫線を引くマクロを教えてください。 エクセルの表を担当者名でシート分割後、空白セル以外に罫線を引きたいのですが 複数シートに罫線を引くマクロを教えてください。 いくつか参考にさせていただき現状以下の様になっています。 元データというシートにAからGまで項目があります PJNo. PJ名 棟No. 棟名 取引先名 　書類　　担当者 1111 PJ１ 10 棟１ 取引先１ 　1 東京 1112 PJ２ 11 棟２ 取引先２　 2 大阪 1113 PJ３ 12 棟３ 取引先３ 　3 名古屋 Sub 担当別シート作成() Application.ScreenUpdating = False For i# = 2 To Worksheets("元データ").Cells(2, 2).End(xlDown).Row j# = 1 '検索中の人のシートが既にできているかを判断する。 For Each sheet_name In Worksheets If sheet_name.Name = Worksheets("元データ").Cells(i, 7).Value Then j = 7 Exit For End If Next '検索中の人のシートがない場合、新規に作成する。 If j = 1 Then Worksheets.Add After:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = Worksheets("元データ").Cells(i, 7).Value For j = 1 To 7 Worksheets(Worksheets.Count).Cells(1, j).Value = Worksheets("元データ").Cells(1, j).Value Next j End If 'データのコピー For j = 7 To 1 Step -1 Worksheets(Worksheets("元データ").Cells(i, 7).Value). _ Cells(Worksheets(Worksheets("元データ").Cells(i, 7).Value). _ Cells(65535, 1).End(xlUp).Row + 1, j).Value = Worksheets("元データ").Cells(i, j).Value Next j Next i 'それぞれのシートの列幅を最適化します。 For Each sheet_name In Worksheets sheet_name.Columns("A:G").AutoFit Next '---- Dim c As Range Range("A1").Select Set c = Selection.SpecialCells(xlCellTypeLastCell) Range(Cells(1, "A"), c).Select （省略）以下罫線を引くマクロ End Sub

  • Visual Basic Editorの実行時エラーのことについて教えてください。　

    Visual Basic超初心者ですがよろしくお願いします。 標準モジュールで入力したものを実行すると、必ず「実行時エラー　"53":　ファイルが見つかりません。」と表示してしまいます。 入力したものはミスはないと思うのですが、何回やってもエラーが出てしまいます。 わかる方いましたら教えてください。 入力したものを一応載せときます↓ Sub list_file() Dim numfile As Long Dim i As Long With Application.FileSearch .NewSearch .LookIn = Range("b1").Value .Filename = Range("b2").Value .SearchSubFolders = Range("b3").Value If .Execute() > 0 Then file_count = .FoundFiles.Count MsgBox file_count & "files exis" Worksheets.Add after:=Worksheets("sheet1") Range("a1").Value = "filename" Range("b1").Value = "date" Range("c1").Value = "size" For i = 1 To file_count Cells(i + 1, 1).Value = .FoundFiles(i) Cells(i + 1, 2).Value = FileDateTime(.FoundFiles(i)) Cells(i + 1, 3).Value = FileLen(.FoundFiles(i)) Cells(i + 1, 2).Value = Hex(Cells(i + 1, 3).Value) Next Columns("a:c").AutoFit Else MsgBox "no file exists" End If End With End Sub

  • エクセルで四者択一の問題を作りたい。・フォーム画面のボタンをクリック、解答、採点画面を出したい。

    一応、フォーム画面で、ボタンをクリックするとデータシートから 持ってきて、それを問題がなくなるまで繰り返したいのですが、うまく いきません。 Private Sub cmd次_click() Dim n As Integer For n = 3 To Cells(Rows.Count, 1).End(xlUp).Row txt設問.Value = Worksheets("データ").Cells(n, 1).Value 　 txt問1.Value = Worksheets("データ").Cells(n, 2).Value txt問2.Value = Worksheets("データ").Cells(n, 3).Value txt問3.Value = Worksheets("データ").Cells(n, 4).Value txt問4.Value = Worksheets("データ").Cells(n, 5).Value n = n + 1 Next n End Sub Private Sub cmd判定_click() If op3.Value = True Then txt正解.Value = "○" Else txt正解.Value = "×" End If End Sub Private Sub cmd消去_Click() txt設問.Value = "" txt問1.Value = "" txt問2.Value = "" txt問3.Value = "" txt問4.Value = "" txt正解.Value = "" op1.Value = "" op2.Value = "" op3.Value = "" op4.Value = "" End Sub よろしければ、教えていただけないでしょうか？

  • ドライブの中のファイル一覧（＆サイズ等）を作成するVBAを教えてください！！

    ドライブの中フォルダーに関する情報を一覧表にして、どのフォルダーがドライブ容量を圧迫しているか調べたく、下記のVBAを書いてみたのですが、うまく走りません。　取得したい内容は、例えば、My Documentの中に入っている、Folder　Name, Size, DateLastModifiedです。サブフォルダーがある場合は、さらにそのフォルダーの上記の情報も取得したいです。 *************************************************************** Sub FolderList() Dim fs As Object, fd As Object, f As Object Dim i As Integer Set fs = CreateObject("Scripting.FileSystemObject") Set fd = fs.GetFolder("C:\Documents and Settings\Ontario91") If f.Type Like "Folder*" Then i = i + 1 Cells(i, 1).Value = f.Name Cells(i, 2).Value = f.DatelastModified Cells(i, 3).Value = f.Size End If Range("A1").CurrentRegion.EntireColumn.AutoFit End Sub *************************************************************** VBA初心者なので、精通されている方たちには、かなり初歩的なコードだと思い、恥ずかしいのですが、質問させていただきます。お力添えよろしくお願い致します。

  • 全部の列でSelection.NumberFormatLocal = "0.00"になってしまう

    以前こちらでお世話になった者です。 教えていただいたコードを応用したのですが、うまくいきません。 以下のようにすると、最後にすべての列の数値が0.00の形になってしまいます。 どこが悪いのか教えてください。よろしくお願いします。 Sub data_torikomi9_1() Dim wb As Workbook Dim Fn As String Dim myPath As String Dim dbBkSh As Worksheet Dim i As Long For Each wb In Workbooks If wb.Name <> ThisWorkbook.Name And _ InStr(1, wb.FullName, "form\", 1) > 0 Then 'formを検索 wb.Close '閉じる End If Next wb myPath = ThisWorkbook.Path & "\" Set dbBkSh = ThisWorkbook.Worksheets("様式9-1") With dbBkSh.UsedRange If .Cells(.Cells.Count).Row > 10 Then .Range("A11", .Cells(.Cells.Count)).Clear End If End With Fn = Dir(myPath & "form\*.xls") i = 1 '画面のちらつきを抑える Application.ScreenUpdating = False Do Until Fn = "" If Fn <> ThisWorkbook.Name Then With Workbooks.Open(myPath & "form\" & Fn, , True) '会社名と企業コード dbBkSh.Range("E2").Value = .Worksheets("inputform").Range("C2").Value dbBkSh.Range("B2").Value = .Worksheets("inputform").Range("M2").Value 'A11 - 1 dbBkSh.Range("A10").Offset(i, 0).Value = i 'B11 - 氏名 dbBkSh.Range("A10").Offset(i, 1).Value = .Worksheets("inputform").Range("C7").Value 'C11 - 番号 dbBkSh.Range("A10").Offset(i, 2).Value = .Worksheets("inputform").Range("H29").Value 'D11 - ポイント dbBkSh.Range("A10").Offset(i, 3).Value = .Worksheets("inputform").Range("H32").Value .Close False i = i + 1 End With End If Fn = Dir() Loop Columns("B:C").Select Selection.HorizontalAlignment = xlLeft Columns("C:C").Select Selection.NumberFormatLocal = "00000" Columns("A:A").Select Selection.HorizontalAlignment = xlCenter Columns("D:D").Select Selection.NumberFormatLocal = "0.00" Range("A6").Select Application.ScreenUpdating = True Set dbBkSh = Nothing End Sub

  • VBAエクセル空白セル0の入力

    C列が空白となるまで、F列・・・L列の空白セルに0を代入する。 という処理を行いたく以下コードで実行をして ファイル種類をCSVにて、保存した後名前の変更で拡張子をTXTにすると データ入力された列の以降がカンマの羅列が「,,,,,,,,(改行)」の繰り返しで表示されてしまいます。 (CSV保存の後、視覚的に空白部分を行選択して削除するとなくなります。) どうすれば、このカンマが表示されなくなるでしょうか。 うまく説明できてないですが、アドバイス御願いします。 Dim i As Long i = 3 Do Until Cells(i, 3).Value = "" If Cells(i, 6).Value = "" Then Cells(i, 6).Value = "0" End If If Cells(i, 7).Value = "" Then Cells(i, 7).Value = "0" End If If Cells(i, 8).Value = "" Then Cells(i, 8).Value = "0" End If If Cells(i, 9).Value = "" Then Cells(i, 9).Value = "0" End If If Cells(i, 10).Value = "" Then Cells(i, 10).Value = "0" End If If Cells(i, 11).Value = "" Then Cells(i, 11).Value = "0" End If If Cells(i, 12).Value = "" Then Cells(i, 12).Value = "0" End If i = i + 1 Loop

  • ファイルオープン時のマクロが一部実行されない

    いつも回答して頂き、ありがとうございます。感謝感謝です。 ファイルオープン時にApplication.Runで３つのマクロを実行させているのですが、最後のマクロだけ実行されません。どうしてでしょうか？もしかして、前の２つで『一覧シート』を除外するマクロを実行しているからでしょうか？御指導の程宜しくお願いいたします。 1番目に実行するマクロ Sub 特定のシート以外の最終履歴と次回予定日を算出する() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Integer c = 3 Do While ws.Cells(2, c).Value <> "" With ws.Cells(6, c) .FormulaR1C1 = "=MAX(R8C:R10000C)" If .Value = 0 Then .Value = "履歴無し" ws.Cells(7, c).ClearContents Else .Value = .Value ws.Cells(7, c) = DateAdd("d", ws.Cells(5, c), DateAdd("m", ws.Cells(4, c), DateAdd("yyyy", ws.Cells(3, c), ws.Cells(6, c)))) End If End With c = c + 1 Loop End If End If Next End Sub ２番目に実行するマクロ Sub 期限の未達と到達を色で分ける() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Long Dim res As Variant For c = 3 To ws.Cells(7, Columns.Count).End(xlToLeft).Column If IsDate(ws.Cells(7, c)) Then If ws.Cells(7, c) > Date Then res = 8 Else res = 3 End If Else res = xlNone End If ws.Cells(7, c).Interior.ColorIndex = res Next c End If End If Next End Sub ３番目に実行するマクロ Sub 各シートの情報を一覧へ転記する() Dim d As Integer Dim retu As Integer d = 3 Do While Cells(d, 2).Value <> "" With Worksheets(Worksheets("一覧").Cells(d, 2).Value) .Activate retu = .Range("IV7").End(xlToLeft).Column .Range(Cells(7, 3), Cells(7, retu)).Copy End With With Worksheets("一覧") .Activate Cells(d, 3).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End With d = d + 1 Loop End Sub

  • ファイル名を合成すると検索できないのでしょうか？

    下記のような式がありまして、一度作成したファイルは上書きされないはずですが何回やっても上書きされてしまいます。 これはファイルを検索していないのでしょうか？ 既にファイルがあったら終了するはずですが何か間違えていますか？ 'ファイル作成 Sub MakeCopyFile(newfile As String, orgfile As String) If SearchFile(newfile) Then Exit Sub End If Set fs = CreateObject("Scripting.FileSystemObject") fs.CopyFile orgfile, newfile End Sub ' ファイル検索 Function SearchFile(fname As String) As Boolean SearchFile = False Set fs = Application.FileSearch With fs .Filename = fname If .Execute() > 0 Then SearchFile = True End If End With End Function Sub Macro1() Dim name As String '名前 Dim fname As String 'ファイル名 Dim directory As String '作成先ディレクトリ Dim fullpath As String 'フルパス Dim orgfile As String '雛形のファイル名 Dim editbook As Workbook '個人データブック Dim id As String '番号 directory = "H:\test\" orgfile = "H:\test\雛形.xls" For i = 1 To 100 name = ThisWorkbook.Worksheets("Sheet2").Cells(i, 10).Value id = ThisWorkbook.Worksheets("Sheet2").Cells(i, 12).Value If name = "" Then Exit For End If 'コピーしたファイルを作成する fname = name + id + ".xls" 'ファイル名合成 fullpath = directory + fname 'フルパス合成 Call MakeCopyFile(fullpath, orgfile) 'ファイル作成 Workbooks.Open Filename:=fullpath Set editbook = Workbooks(fname) editbook.Worksheets("Sheet3").Cells(8, 14).Value = name editbook.Worksheets("Sheet3").Cells(8, 10).Value = id '※(その他必要な処理があれば追加してください) editbook.Close (True) Next i End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する