• ベストアンサー

CSVの前ゼロを消さずにエクセルマクロで読み込む方法

市外局番、市内局番、加入者番号を別フィールドで記録したCSVがあります。(120列) エクセルでそのまま読み込むと前ゼロが消えてしまうので、以下の方法をとっています。 1.拡張子変更   hoge.csv を hoge.txt に変更 2.ファイル→開く→テキストファイル→hoge.txtを選択 3.テキストファイルウィザード 4.電話番号の項目を「文字列」に指定する。 この一連の流れをマクロにしたいのですが、うまくいきません。 [マクロ1]  Sub csv_open1() Dim myFieldInfo(1 To 256) As Variant Dim i As Integer Dim strFileName strFileName = Application. _ GetOpenFilename If strFileName <> False Then For i = 1 To 256 myFieldInfo(i) = Array(i, 2) Next Workbooks.OpenText strFileName, _ DataType:=xlDelimited, _ Comma:=True, FieldInfo:=myFieldInfo End If End Sub ▼結果  失敗。前ゼロが消えた状態で読み込まれた。  Arrayの256を120にしても同様でした。 myFieldInfo(i) = Array(i, 2)で文字列に指定したはずなのになぜ文字列にならないのでしょうか。 ご存知の方、よろしくお願いいたします。

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

  • ベストアンサー
  • salf
  • ベストアンサー率42% (27/64)
回答No.2

さらに気になったんで調べてみました。 どうやら、拡張子が csv だとすでに関連付けされているためうまくいかない模様です。 それで解決法として QueryTables というものが使用できるようです。 以下がコードとなります。 Sub csv_open1() Dim strFilePath As String Dim strFileName As String Dim ifind1 As Integer strFilePath = Application.GetOpenFilename ifind1 = InStrRev(strFilePath, "\") strFileName = Mid$(strFilePath, ifind1 + 1) Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = strFileName With Sheets(strFileName).QueryTables.Add(Connection:="TEXT;" & strFileName, Destination:=Range("A1")) .TextFileParseType = xlDelimited .TextFileCommaDelimiter = True .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2) .Refresh End With End Sub このコードでうまくいきましたよ。

tigarato
質問者

お礼

2,2,2,2,2,2,2,2の数を増やすことで無事マクロが結果を出しました。 ありがとうございました。

その他の回答 (2)

回答No.3

ツール→データ→外部データの取込→テキストファイルのインポート を実行すれば、拡張子がCSVのままでも問題ありません。 もちろん、フィールドのデータ型は文字列にする必要はありますが。 詳しくは、マクロの記録を行って見てください。

tigarato
質問者

お礼

これなら拡張子を変えずにできそうですね。 拡張子を変えるのが最大のネックだったもので助かります。 ありがとうございました。 マクロの記録でいろいろ応用ができそうです。

  • salf
  • ベストアンサー率42% (27/64)
回答No.1

ちょっと気になってんで私も調べてみました。 できないですね、確かに・・・。 私が調べた範囲だと、拡張子の csv がどうもだめなようです。 ためしに同じコードを csv からほかの拡張子に変更して起動してみると正常に動作します。 なんでやるとしたら csv ファイルを拡張子を変更してコピーしてそれを開くって方法ぐらいしか 残念ながら今の状態では思い浮かびません。。。 これって仕様なんですかね???

tigarato
質問者

お礼

ありがとうございます。 確かにcsv以外にすれば正常に読めました。 1.拡張子変更   hoge.csv を hoge.txt に変更 2.マクロ実行 と手順は短縮できますが、拡張子を変更という作業を伴うのは困ったものです。

関連するQ&A

  • VBAでCSVを文字列として取り込む方法

    VBAでCSVを文字列として取り込む方法を教えてください。 下記のようにCSVファイルを取り込んでいます。 Array関数を使用していますが、どうしても文字列として認識してくれません。 Sub CSV取り込み() Dim xlAPP As Application ' Applicationオブジェクト Dim strFILENAME As String ' OPENするファイル名(フルパス) 'Applicationオブジェクト取得 Set xlAPP = Application '「ファイルを開く」のフォームでファイル名の指定を受ける xlAPP.StatusBar = "読み込むファイル名を指定して下さい。" strFILENAME = xlAPP.GetOpenFilename(FileFilter:=cnsFILTER, Title:=cnsTITLE) 'キャンセルされた場合は以降の処理は行なわない If StrConv(strFILENAME, vbUpperCase) = "FALSE" Then Exit Sub Workbooks.OpenText Filename:=strFILENAME, _ DataType:=xlDelimited, comma:=True, _ fieldinfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), _ Array(4, 2), Array(6, 2)) Workbooks.Open Filename:=strFILENAME ActiveWorkbook.Sheets(1).Cells.Copy _ Destination:=ThisWorkbook.Worksheets("sheet1").Range("A1") End Sub この書式ではCSVを文字列として取り込めないのでしょうか? どなた様かご教示ください。 よろしくお願いいたします。

  • Excel VBAでOpenTextのFieldInfoが効かない・・

    Excel2000のVBAマクロで、CSVファイルを読み込んで マッチング処理をしたいと考えています。 CSVファイルはコードテーブルで参照のみ。 中身は、「コード,名前,区分」の配列になっております。 コードは"0012345"と"12345"は別物として扱いたいので 文字列として読み込む必要があります。 CSVファイルの中身は以下の感じです。 12345,名前1,区分1 0012345,名前2,区分2 0000022222,名前3,区分1 ... そこで、以下のようなコードを書いて見ました。 Sub OpenCSV() Workbooks.OpenText Filename:="C:\CSV.txt" _ DataType:=xlDelimited, Comma:=True, _ TextQualifier:=xlTextQualifierNone, _ FieldInfo:=Array(Array(1,2),Array(2,2), _ Array(3,2)) End Sub ところが開いたシートではコード部分が文字列として 取り込まれておらず、セルの書式も標準になっています。 FieldInfoの設定方法を変えて、 Sub OpenCSV() Dim tmpInfo(256) As Variant Dim i As Integer For i = 1 to 256 tmpInfo(i) = Array(i,2) Next Workbooks.OpenText Filename:="C:\CSV.txt" _ DataType:=xlDelimited, Comma:=True, _ TextQualifier:=xlTextQualifierNone, _ FieldInfo:=tmpInfo End Sub このようなコードにしたところ、「型が一致しない(エラー13)」というエラーになってしまいます。 結局、FieldInfoが効いてない動きなのですが、 どこが悪いのか皆目見当が付きません。 アドバイスを頂けますと幸甚です。

  • エクセルVBAにてテキスト出力がうまくいきません

    エクセルシートの1列に以下のような文字列を打ち込みました。 - a aa aaa aaaa aaaaa - b bb bbb bbbb bbbbb - c cc ccc cccc ccccc - 「-」の2行後をテキストを出力した際のファイル名とし、ファイル名を含んだ次の「-」までの文字列をそのテキストの中に出力したいです。なお、全体の行数は分かっています。 例えば上の文字列に対して実行すると、 a.txt b.txt c.txt というファイルができ、それぞれの中には a aa aaa aaaa aaaaa などがそれぞれ出力されるようにしたいです。 Sub tepa() Dim strFilename As String Dim FileNumber As Integer Dim strREC As String j = 1 For i = 1 To 70 If Cells(i, 1) = "-" Then strFilename = Cells(i + 2, 1) & ".txt" Do While Cells(i + j, 1) <> "-" If i > 70 Then Exit Sub End If FileNumber = FreeFile strREC = Cells(i + j, 1) Open strFilename For Append As FileNumber Print #FileNumber, strREC Close j = j + 1 Loop End If i = i + j Next End Sub さきほど初めてVBAなるものを知り、見よう見まねで書いてみましたが・・・ループに陥ったりテキストファイルが1つめしか出力されなかったりとうまくいきません。 改善点など教えていただけたら嬉しいです。 よろしくお願いします。

  • 複数のエクセルシートをまとめるマクロ

    下は複数のエクセルファイルを一つにするマクロですが、100万件を超えるためcsvで保存するようにするにはどこを変更したらよいでしょうか。 よろしくお願いします。 Sub Sample() Dim t As Single Dim strPath As String Dim strFileName As String Dim WB1 As Workbook Dim WS1 As Worksheet Dim WS2 As Worksheet Dim lngRowCount As Long 'A列に値が入っているデータ数 t = Timer 'まとめたいシート Set WS2 = ThisWorkbook.Worksheets(1) strPath = ThisWorkbook.Path strFileName = Dir(strPath & "\*.xls*") Do While strFileName <> "" If strFileName <> ThisWorkbook.Name Then Set WB1 = Workbooks.Open(strPath & "\" & strFileName) Set WS1 = WB1.Worksheets(1) With WS1.Range("A1") lngRowCount = .Worksheet.Cells(.Worksheet.Rows.Count, .Column).End(xlUp).Row - .Row If lngRowCount >= 1 Then With .Resize(lngRowCount, 14).Offset(1) .Copy WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1) End With End If End With WB1.Close False End If strFileName = Dir Loop MsgBox "まとめ処理をしました。処理時間 " & Format((Timer - t) / 60 / 60 / 24, "h:mm:ss") End Sub

  • エクセルのマクロについて

    下記は、A列3行の7文字目~10文字と B列5行~文字のある最後の行までの範囲の左から1文字目~4文字 に相違がある場合 MsgBox i & “行目” を出す。 というマクロなのですが、『B列5行~文字のある最後の行までの範囲』の中でも『空白のセルに関してはMsgBox不要』というふうに付加えたいのですがどのようにすればよいでしょうか。 Sub Macro1() Dim i As Long Dim sOrgText As String Dim ltotal As Long With ActiveSheet sOrgText = Mid(.Cells(3, 1), 7, 4) ltotal = .Cells(65536, 2).End(xlUp).Row For i = 5 To ltotal If Not Mid(.Cells(i, 2), 1, 4) = sOrgText Then MsgBox i & "行目" End If Next i End With End Sub

  • 【VBA】ExcelマクロでCSVファイルに保存したデータが""で囲まれてしまう

    添付図のような、Excel2003で作成した表内のデータを CSVで保存するマクロを作成したのですが、 図のように、CSVファイルに「""」で値が囲まれた状態で、 保存されてしまいます。 下記にマクロを記載しますので、 どうすれば文字列が「""」で囲まれずに、 カンマ区切りだけのデータで出力されるのか、 ご存知の方おられましたら、ご教示お願い致します。 Sub csv保存() Dim フォルダ名 As String Dim パス名 As String Dim ファイル名 As String Dim データ As Variant Dim 行数 As Long, 列数 As Integer Dim i As Integer, j As Long, k As Long ファイル名 = "test.csv" フォルダ名 = "csv" パス名 = ActiveWorkbook.Path & "\" & _ フォルダ名 'csvフォルダが存在しなければ作成する If Dir(パス名, vbDirectory) = "" Then MkDir パス名 End If ChDir パス名 Open ファイル名 For Output As #1 For i = 1 To Worksheets.Count Worksheets(i).Activate Worksheets(i).Cells(1, 1).Select ActiveCell.CurrentRegion.Select 行数 = Selection.Rows.Count 列数 = Selection.Columns.Count For j = 1 To 行数 For k = 1 To 列数 - 1 データ = Selection.Cells(j, k) _ .Value Write #1, データ; Next k Write #1, Selection.Cells(j, 列数) _ .Value Next j Next i Close #1 End Sub

  • エクセル2007で既に開かれているCSVファイル

    のセルA1に特定の文字が入力されているファイルに対してマクロを実行したいのです。 会社のイントラネットから各種データを開くと(ダウンロードではありません。)以下のファイル名になります。 list.csv , list(1).csv , list(2).csv , list(4).csv , … , list(n).csv ←list(3).csvは不要だったので閉じられている例です。 マクロ実行前に、例えば list.csv と list(4) のセルA1に特定の文字が入力されている場合は、どちらかを選択するか、処理を中止する。(希望は前者ですが。。。) 対象のCSVファイルが無ければ(CSVファイルが開かれていない、または、A1が不一致)メッセージを出力する。 Sub Sample() Dim myChkBook As Workbook Dim i As Integer On Error GoTo Err0 Set myChkBook = Workbooks("List.csv") 'この時にセルA1の文字を比較したいです。 Call 処理 Exit Sub Err0: For i = 1 To 5 '←5は少なくとも list(n).csv のnまで処理したい。 On Error Resume Next Set myChkBook = Workbooks("List(" & i & ").csv") '←現状では、開かれていないファイルが On Error GoTo 0                      'あるとエラーになってしまいます。 Call 処理 Exit Sub Next i Exit Sub Err1: MsgBox "対象のCSVファイルが見つかりませんでした。" End Sub 出だしで躓いてしまい、悩んでおります。 良い方法をご教示いただければと思い、質問致します。 宜しくお願い致します。

  • Excelのマクロについて

    文字列から数値だけを抽出するマクロを見つけたのですが、抽出するデータを選択してから実行しなければなりませんでした。 抽出するデータはAセル以下にしかないので、データを選択しないでも実行できるようにするにはどうしたら良いのでしょうか? 宜しくお願いします。 以下見つけたマクロです。  Sub test()  Dim mydata As String  Dim c As Range  Dim i As Integer  For Each c In Selection   mydata = ""  For i = 1 To Len(c)   If Mid(c, i, 1) >= 0 And Mid(c, i, 1) <= 9 Then   mydata = mydata & Mid(c, i, 1)    End If   Next   c.Offset(0, 1) = mydata   Next  End Sub

  • 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

  • 自動的にcsvでエクスポートしてくれるマクロ

    sheetがいくつかあり、指定したsheetを自動的にcsvで吐き出してくれるマクロを作成中です。 Sub Macro1407() Dim fText As String Open "C:\Documents and Settings\人事ファイ ル.xls" For Input As #1 Open "C:\Documents and Settings\pgotouy\人事 ファイル.csv" For Output As #2 Close #1 Close #2 End Sub これだとうまくいってくれませんでした。どなたかアドバイスお願いします。出来ればついでにxmlで吐き出すマクロについてもお願いします。