• ベストアンサー

ExcelVBAを使ってテキストファイルを取り込む際に条件を与える方法

こんばんわ。 今、テキストファイルをExcelの特定シートに開くVBAを組もうとしています。 ある書籍のソースをそのまま流用すると、 一部分は満たされるのですが、他方が実現されず、困っております。 やろうとしていること: 新規ブックを開かずに、テキストファイル(CSV形式)の各列の形式(文字列or数値)を指定しながら、特定シートにデータを展開する。 Book名「ABC.xls」 その中のシート名「展開」 テキストファイル名「data.txt」:11列のデータがカンマ区切りで入っています data.txt、ABC.xls共に同じフォルダ内に保存してあります。 やってみたこと: *********************************************** Sub ReadTxt() Dim myTxtFile As String Dim myBuf(11) As String Dim i As Integer, j As Integer Application.ScreenUpdating = False myTxtFile = ActiveWorkbook.Path & "\data.txt" Worksheets("展開").Activate 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) i = i + 1 For j = 1 To 11 Cells(i, j) = myBuf(j) Next j Loop Close #1 End Sub *********************************************** というソースで特定シートに取り込めたのですが、 各列の取り込み形式(文字列、数値)を指定する方法がわかりません。 OpenTextメソッドでFieldInfoに配列を記述し取り込み形式を指定する方法は見つけたのですが、こちらは、新規ブックが開いてしまい・・・ どなたか方法をご存知の方、回答を頂けたら幸いです。 お願いします。

  • kenton
  • お礼率74% (110/148)

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

  • ベストアンサー
  • nishi6
  • ベストアンサー率67% (869/1280)
回答No.2

読み込む前に対象の11列の属性を決めてしまえば問題はないと思いますが・・・ 下はその例です。 文字列設定していないと読み込み結果が変わってしまう例として、  1-2-3 の様は文字列が日付になる  0001 の様な前ゼロが数値になってしまう(前ゼロが消える)  02E01 のような文字列が指数表示の数値になってしまう このような事例が思い浮かびますが、スペースで挟まれた数値などはスペースが無視されるはずです。このようなデータに対しては、元のテキスト(CSV)ファイル側で、""で囲む必要があると思います。 OpenTextで読み込んで、対象のシートコピーする方法も考えられます。 対応例です ↓ Sub ReadTxt()   Dim myTxtFile As String   Dim myBuf(11) As String   Dim i As Integer, j As Integer   Application.ScreenUpdating = False   myTxtFile = ActiveWorkbook.Path & "\data.txt"   Worksheets("展開").Activate   '==================== 以下を追加 ========================   Dim C As Integer   For C = 1 To 11     Select Case C       'A、C、D、H、I列は標準(数値)の例       Case 1, 3, 4, 8, 9         Columns(C).NumberFormatLocal = "G/標準"       'B、E、F、G、J、K列は文字列の例       Case Else         Columns(C).NumberFormatLocal = "@"     End Select   Next   '========================================================   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)     i = i + 1     For j = 1 To 11       Cells(i, j) = myBuf(j)     Next j   Loop   Close #1 End Sub

kenton
質問者

お礼

教えていただいたソースで実験してみたところ、 見事目的の結果を導けました。 ありがとうございます。 また、何かの際には質問していると思いますが、見かけましたら、助言をいただけると幸いです。

kenton
質問者

補足

回答ありがとうございます。 質問での記入に漏れていた部分まで憶測して頂いている回答、本当に感謝いたします。 nitscapeさんへのお礼にも書きましたが、全て数値の物の中から、頭に”0”が付くような数値を文字列にしようと試みていたものでした。 その点で、 >0001 の様な前ゼロが数値になってしまう(前ゼロが消える) >      'B、E、F、G、J、K列は文字列の例 >      Case Else >        Columns(C).NumberFormatLocal = "@" という回答はBingoかもしれません。 本日は、明日のことも考えると試せませんが、 明日移行試して、再びお礼をしたいと思います。 変数を設けて、文字列に指定したい列にNumberFormatLocalプロパティ(?)を指定してやれば良いのですね。 実行してみて、またわからない点は質問するかもしれませんが、その後目に付いた際にはお付き合い願えると幸いです。 ありがとうございます。

その他の回答 (1)

  • nitscape
  • ベストアンサー率30% (275/909)
回答No.1

 数値型に変更してから値をセルに書き込んでみたらどうでしょうか?  文字列から数値に直す関数名を忘れてしまいまたパソコンにExcelなどが入っていないので分かりません。ここではint()としています。  もし数字だけを含む文字列だけを数値としてという条件にするのであれば全文字チェックして0-9であればTRUEを返すような関数を作ればいいのではないでしょうか。 i = i + 1 For j = 1 To 11 if j = 1 then Cells(i, j) = int(myBuf(j)) else Cells(i, j) = myBuf(j) end if Next j Loop

kenton
質問者

お礼

返答が遅れてしまって申し訳ありません。 >もし数字だけを含む文字列だけを数値としてという条件にするのであれば全文字チェックして0-9であればTRUEを返すような関数を作ればいいのではないでしょうか。 質問の際に記入しておけばよかったのですが、全て数値の中から1列目の数値のみを文字列として扱おうとしてあれこれやっていました。 それは、”XXXX”という数値でして、頭から数桁が”0”になり得るので、それをどうにかして文字列として扱いたく、ここに質問した次第です。 この”XXXX”は商品コードでして、頭につく”0”も含めて、取り込んだ後の処理でVLOOKUP関数にて、取り込んだ数値の右側のセルを参照しようと試みていたものでした。 説明が足りず申し訳ありませんでした。 関数を作るというところまでVBAに関して理解しておりませんが、今後何かの際に参考にさせて頂こうと思います。 回答ありがとうございました。

関連するQ&A

  • ブックをひらかずにテキストファイルを取り込む

    エクセルのブックを開かずにテキストファイルを取り込みたいのですが、対象のテキストファイルは タブで分かれています。 本を見て 下記のプロシージャを使用したいのですが、 テキストが取り込まれるブックに郵便番号と言うシートを作成してもうまく取り込めません。 テキストはタブで区切られたテキストで 7列のデータです。 下記のものを開こうとすると、7列でデータが入るのですが、タブでデータが区切られてこないのです。 データが続いて一つのセルに入ってしまい、 うまく設定できません。 何がいけないのでしょうか? 宜しくお願いします。 Sub ReadTxt() Dim myTxtFile As String Dim myBuf(7) As String Dim i As Integer, j As Integer Application.ScreenUpdating = False myTxtFile = ActiveWorkbook.Path & "\Fuji.txt" Worksheets("郵便番号").Activate 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) 'データをセルに展開する i = i + 1 For j = 1 To 7 Cells(i, j) = myBuf(j) Next j Loop Close #1 End Sub

  • ブックに可変のファイル名テキストファイルからデータを取り込みたい

    こんにちは 昨日質問させていただいた、コードを修正して 開かれるファイル名が可変である場合にも対応させたいのですが、"*"をもちいてみてもうまく行きません。 どの様に指定するのかご存知の方教えてください。 "\Fuji.txt"これを\****.txt \*.txtとやってみましたがダメでした。 なお、041221_fuji.txtのように日付を6桁と"_"を入れてfujiとしたく、日付の6桁の数字のみ変えたいのです。 それを下記のコードに盛り込みたいのですが、何が足りないのかうまく行きません。 宜しくお願いします。 Sub ReadTxt() Dim myTxtFile As String Dim myBuf As String, wkdt() As String Dim i As Integer, j As Integer Application.ScreenUpdating = False myTxtFile = ActiveWorkbook.Path & "\Fuji.txt" Worksheets("郵便番号").Activate Open myTxtFile For Input As #1 Do Until EOF(1) Line Input #1, myBuf wkdt = Split(myBuf, vbTab) 'データをセルに展開する i = i + 1 For j = 0 To UBound(wkdt) Cells(i, j + 1) = wkdt(j) Next j Loop Close #1 End Sub

  • テキストファイルを開く際のFor文の使い方

    質問です。あるフォルダに入っているテキスト形式のデータ10個をエクセルで開いていくVBAのプログロムを書いているのですが、エラー文で「データ_i.txtがありません」と表示されます。私の書いたプログラムは下記です。 Sub テスト() テスト Macro Dim i As Integer For i = 0 To 5 ChDir "C:\Documents and Settings\データ" Workbooks.OpenText Filename:= _ "C:\Documents and Settings\データ\_i.txt" _ , Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ TrailingMinusNumbers:=True Next i End Sub このプログラムの目的は、テキストデータの入っているフォルダを他の名前に変更したときも、その中に入っているテキストデータ10個をエクセルで展開するためです。おそらく"C:\Documents and Settings\データ\_i.txt"のiの部分が間違えていると思うのですが、どうすればいいでしょうか?よろしくお願いします。

  • テキストファイルを開く際のFor文の使い方

    質問です。あるフォルダに入っているテキスト形式のデータ10個をエクセルで開いていくVBAのプログロムを書いているのですが、エラー文で「i.txtがありません」と表示されます。私の書いたプログラムは下記です。 Sub テスト() テスト Macro Dim i As Integer For i = 0 To 5 ChDir "C:\Documents and Settings\データ" Workbooks.OpenText Filename:= _ "C:\Documents and Settings\データ\i.txt" _ , Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ TrailingMinusNumbers:=True Next i End Sub このプログラムの目的は、テキストデータの入っているフォルダを他の名前に変更したときも、その中に入っているテキストデータ10個をエクセルで展開するためです。おそらく"C:\Documents and Settings\データ\i.txt"のiの部分が間違えていると思うのですが、どうすればいいでしょうか?よろしくお願いします。

  • エクセルのデータを大量のテキストファイルに書き込みたい。

    エクセルの縦のセルのデータ(下のCells( 4 * j + i, 4))を繰り返しで、400個のテキストファイルに書き込みたいのですが、 下の""内のjは繰り返しせずに、j.txtとなって入力されてしまいます。なにかいい方法がありませんでしょうか。 ご協力お願いします。(ちなみにvbaは初心者です。) Private Sub CommandButton2_Click() Dim n As Long n = FreeFile Dim j As Integer For j = 0 To 399 For i = 1 To 4 a = Cells( 4 * j + i, 4) f2 = ActiveWorkbook.Path & "\j.txt" Open f2 For Append As #n Print #n, a Close #n Next i Next j End Sub 例. 1 2 3 4 5 6 7 8 9 10 12 13 1,2,3,4→1.txt 5,6,7,8→2.txt 9,10,11,12→3.txt

  • エクセルからテキストファイルはきだし

    エクセルのひとつのシートの内容をテキスト形式で吐き出すマクロを教えてください。 エクセルでHTMLメルマガの商品名や金額を編集できるようにしたいのですが、その編集後のファイルをテキストで出すマクロのVBAの書き方を教えてください。 現在、以下で書いておりますがエクセルの中にある「$」が消えてしまいます。$が消えないような書き方を教えてください。また、""が余分についてしまう書き方は避けたいです。よろしくお願い致します。 Sub test() Dim StrFN As String StrFN = ActiveWorkbook.Path & "\data.txt" Dim i As Long, LngLoop As Long Dim IntFlNo As Integer Worksheets("HTML").Activate LngLoop = Range("a65536").End(xlUp).Row IntFlNo = FreeFile Open StrFN For Output As #IntFlNo For i = 1 To LngLoop Print #IntFlNo, Cells(i, 1) Next i Close #IntFlNo End Sub

  • EXCELVBAでデータをテキストファイルで出力したいと

    EXCELVBAでデータをテキストファイルで出力したいと考えています。 ***************************** 作成したVBA ***************************** Sub test_Click() Dim fNAME As String fNAME = "c:\test.txt" Open fNAME For Output As #1 i = 1 Print #1, "<test=" & Cells(1, i) & "," & Cells(2, i) & "," & Cells(3, i) & "," & Cells(4, i) & "," & Cells(5, i) & ">" Close #1 '閉じる End Sub ***************************** エクセルの値 ***************************** A列 1 2 3 4 5 ***************************** 出力されたテキストファイル ***************************** <test=1,2,3,4,5> このようになっていますが、 エクセルが A列 1 2 のように、2個しかないと、 <test=1,2,,,> のようになってしまいます。 <test=1,2> ↑のようになるように、エクセルの値に応じて、 「,」が出力しないようにしたいです。 どうしたらよいのでしょうか。 よろしくおねがいします。

  • エクセルVBA ファイル名を変えながらtxtファイルに出力する方法

    エクセルVBA初心者です 名前/科目 国語 数学 英語 合計 A 53 45 12 110 B 58 59 74 191 C 80 69 58 207 D 45 97 66 208 E 35 85 53 173 F 89 13 79 181 このシート内容を一行ずつテキストファイルに出力したいと考えております。 ファイル名を 生徒A.txt のように生徒・セルの値にしたい場合はどのようにすればよいでしょうか? 分かる範囲で書いたものを載せました アドバイスよろしくお願いします。 Sub test1() Dim ken As Long Dim i As Integer Dim j As Integer Dim fn As Integer fn = FreeFile() ken = Range("a65536").End(xlUp).Row For i = 2 To ken Open "C:\■■■.txt" For Output As #fn For j = 1 To 5 Write #fn, Cells(i, j); Tab; Next j Print #fn, "" Close #fn Next i End Sub

  • エクセル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つめしか出力されなかったりとうまくいきません。 改善点など教えていただけたら嬉しいです。 よろしくお願いします。

  • テキストデータExcel取込時の文字化け、その他

    VBA初心者です。 やりたいことは以下の通りです。 カンマ区切りの文字が記載された.txtデータをExcelファイルに取り込みたいと思っています。 (1)自動でフォルダを開いて手動で任意のテキストデータを選ぶ (2)データを文字 化けなくカンマ区切りでセルごとにExcelに表示 (3)元データの.txtはファイルによって空白行が1行のときもあれば2行のときもありまちまちなので自動で空白行をスキップして呼び込みたい (4)呼び込んだ.txtの内容を元に読み込先のExcelに関数(I列に来るべき.txtのデータを参照してJ列「収支」K列「勝率」が出る)が仕込んであるが、ファイルによってデータの行数が違うため最終行を取得したい 特定の.txtファイルではなくこちらで選べるようにしたいので以下に示したソースの通りGetOpenFilenameで自動でファイルを開いて手動で選べるようにしています。 その際、一部別の漢字に変換されたり、カンマがひとつだけ・に代わっていたり文字化けがあります。 呼び込みたい.txtは空白行が1行あったり、2行あったりするのでそこをスキップして純粋に文字のある行から取り込みたい。読み込み先のExcelには事前に項目を作っているため、空白行をスキップできれば自動的に項目の下にデータが表示されるようになっています。※予め空白のないテキストを呼び込んでテストすると(文字化けは別として)上手くいきました。 (4)は難しくてもせめて(1)~(3)までは自力でできないかと調べていますがうまくいきません。UTF-8をANTI形式に保存しても直ったり直らなかったり、またVBAのADODB.Streamオブジェクト(Microsoft ActiveX Data Objects x.x Library)を試そうとするもファイルパスやターゲットで特定のファイルを指定する部分があり、それを指定しないで使うにはどうすればいいのかがわかりません。 ご査収いただけましたら嬉しいです。 下記はネットのソースを一部直して作成。これを利用してできないでしょうか。 Option Explicit '=================================================================================================== Private Const g_cnsTitle As String = "テキストファイル読み込み" Private Const g_cnsFilter As String = "全てのファイル (*.*),*.*" Sub Txt読み込み() Dim varFileName As Variant Dim intFree As Integer Dim strRec As String Dim strSplit() As String Dim i As Long, j As Long varFileName = Application.GetOpenFilename(FileFilter:="txtファイル(*.txt),*.txt", _ Title:="txtファイルの選択") If varFileName = False Then Exit Sub End If intFree = FreeFile '空番号を取得 Open varFileName For Input As #intFree 'txtファイルをオープン i = 0 Do Until EOF(intFree) Line Input #intFree, strRec '1行読み込み i = i + 1 strSplit = Split(strRec, ",") 'カンマ区切りで配列へ For j = 0 To UBound(strSplit) Cells(i, j + 1) = strSplit(j) Next '配列をそのまま入れる方法も、ただし全て文字列として入力される 'Range(Cells(i, 1), Cells(i, UBound(strSplit) + 1)) = strSplit Loop Close #intFree End Sub