• 締切済み

Excel VBA 出力について

txtファイルの出力をしたいのですが 調べながらやっていたのですがよくわかりませんでした。 あまり時間が取れない為 コードの記述方法を教えてください。 vbaの処理を行ってできたstrCompSheetNmのSheetがあります。 このSheetのデータを出力したいのです。 またこのSheetの行数は非固定になります。 出力元をどこかで指定してあげないといけないのかと思うのですが 記述方法がわからず いろいろなサイトを参考にしながらやってみても 内容が空のファイルができあがったりしてました。 出来たら 出力時 同名のファイルがあった場合 上書き又はファイル名を変更できるようにしたいのです。 いろいろ書きなおした上で下記の状態でとまっております。 ご回答のほう宜しくお願い致します。 不慣れでもうしわけないです。 現状 Dim SaveFileName As Variant Dim wScriptHost As Object, strInitDir As String Set wScriptHost = CreateObject("WScript.Shell") ChDir wScriptHost.SpecialFolders("Desktop") 'Dim YeDate As String 'YeDate = Format(Date, "yyyymmdd") SaveFileName = Application.GetSaveAsFilename(Format_ (Date, "yyyymmdd"), "テキストファイル(*.txt),*.txt,_ CSVファイル(*.csv),*.csv") If SaveFileName <> False Then Dim FlNum As Integer Dim GYO As Long Dim GYOMAX As Long FlNum = FreeFile Open ThisWorkbook.Path & SaveFileName For Output As FlNum GYO = 1 Do Until GYO > GYOMAX Print #FlNum, GYO = GYO + 1 Loop Close #intFF Else MsgBox "キャンセルがクリックされました。", vbInformation End If

みんなの回答

  • rivoisu
  • ベストアンサー率36% (97/264)
回答No.3

当然print #Flnum、 の後には出力するセルの記述が必要ですよ。 (突っ込み忘れ) あちこち調べるのはいいけど コードの意味を理解しないと、よさそうなのを寄せ集めただけではプログラムは動きません。

hime_aqua
質問者

お礼

なんとか解決できました。 ありがとうございました。

  • rivoisu
  • ベストアンサー率36% (97/264)
回答No.2

>いろいろ書きなおした上で下記の状態でとまっております。 現在どうなっているのか「止まっている」ではわからない出力がおかしい、出力されない、エラーになる(どこでどんな) 突っ込みどころ満載のコードですが 取り合えず目に付いたところ Open ThisWorkbook.Path & SaveFileName For Output As FlNum #FlNum にする Do Until GYO > GYOMAX このコードだとGYOMAXに値が入っていないので何もしない 多分この場合 GYOMAX=Cells(Rows.Count, 1).End(xlUp).Row 繰り返し回数が決まっているのならDo Until より普通はfor Next For GYO = 1 to GYOMAX   Print #FlNum, Loop Dim wScriptHost As Object, strInitDir As String Set wScriptHost = CreateObject("WScript.Shell") ChDir wScriptHost.SpecialFolders("Desktop") 使ってないので意味が無い If SaveFileName <> False Then Dim FlNum As Integer Dim GYO As Long Dim GYOMAX As Long 変数宣言はif文の中でやるのはちょっと...

回答No.1

>あまり時間が取れない為 >コードの記述方法を教えてください。 「ファイル」-[名前を付けて保存」でファイルの種類を「テキスト(タブ区切り)」か「CSV」にして保存。 これをマクロ記録して修正するのが一番早そう。

hime_aqua
質問者

補足

 " 込の文にさらに単語ごとに " が入ってしまうなど あったので 諦めて 時間かけてやることにします。 こんなこと 投稿で聞くべき内容ではなかったですねすいません。

関連するQ&A

  • エクセル VBA テキストファイル書き出す応用?

    以下のページより、 http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_040.html Option Explicit ' テキストファイル書き出すサンプル(2) Sub WRITE_TextFile2() Const cnsFILENAME = "\SAMPLE.txt" Dim intFF As Integer ' FreeFile値 Dim strREC As String ' 書き出すレコード内容 Dim GYO As Long ' 収容するセルの行 Dim GYOMAX As Long ' データが収容された最終行 ' 最終行の取得 GYOMAX = Range("A65536").End(xlUp).Row ' FreeFile値の取得(以降この値で入出力する) intFF = FreeFile ' 指定ファイルをOPEN(出力モード) Open ThisWorkbook.Path & cnsFILENAME For Output As #intFF ' 2行目から開始 GYO = 2 ' 最終行まで繰り返す Do Until GYO > GYOMAX ' A列内容をレコードにセット(先頭は2行目) strREC = Cells(GYO, 1).Value ' レコードを出力 Print #intFF, strREC ' 行を加算 GYO = GYO + 1 Loop ' 指定ファイルをCLOSE Close #intFF End Sub ------------------------------------------------------------- これを参考にしてテキストファイル書き出すのは出来たのですが、 今回は、ちょっと応用で以下のようにしたいです。 Sheet1のA2~A20までテキストファイル名が書いてあるとします。 また、Sheet2~Sheet20ぐらいまで、各Sheetに文章が入っているとします。 テキストファイルに書きだしたいのですが、 Sheet2の内容は、Sheet1のA2のファイル名 Sheet3の内容は、Sheet1のA3のファイル名 Sheet4の内容は、Sheet1のA4のファイル名 このようにしたいのですが、どのようにすればいいのか教えてください。 よろしくお願います。

  • VBAでのテキストデータ追記

    VBAを使ってデータをテキストファイルに追記したいのですが、 A列だけじゃなく A列からF列までのデータを追記させたいと 考えているのですが、 どうやるのか理解できません。 教えていただけますでしょうか? -------------------------------------------------------------- Option Explicit ' テキストファイル書き出すサンプル Sub WRITE_TextFile() Const cnsTitle = "テキストファイル出力処理" Const cnsFilter = "テキストファイル (*.txt;*.dat),*.txt;*.dat" Dim xlAPP As Application ' Applicationオブジェクト Dim intFF As Integer ' FreeFile値 Dim strFileName As String ' OPENするファイル名(フルパス) Dim vntFileName As Variant ' ファイル名受取り用 Dim strREC As String ' 書き出すレコード内容 Dim GYO As Long ' 収容するセルの行 Dim GYOMAX As Long ' データが収容された最終行 Dim lngREC As Long ' レコード件数カウンタ ' Applicationオブジェクト取得 Set xlAPP = Application ' 「名前を付けて保存」のフォームでファイル名の指定を受ける xlAPP.StatusBar = "出力するファイル名を指定して下さい。" ' (1) vntFileName = xlAPP.GetSaveAsFilename(InitialFilename:="SAMPLE.txt", _ FileFilter:=cnsFilter, _ Title:=cnsTitle) ' キャンセルされた場合はFalseが返るので以降の処理は行なわない If VarType(vntFileName) = vbBoolean Then Exit Sub strFileName = vntFileName ' 収容最終行の判定(Excel認知の最終行から上に向かってデータがある行を探す) With ActiveSheet If .FilterMode Then .ShowAllData ' オートフィルタ解除 End With GYOMAX = Cells(65536, 1).End(xlUp).Row ' (2) If GYOMAX < 2 Then xlAPP.StatusBar = False MsgBox "テキストをA列2行目から入力してから起動して下さい。", , cnsTitle Exit Sub End If ' FreeFile値の取得(以降この値で入出力する) intFF = FreeFile ' 指定ファイルをOPEN(出力モード) Open strFileName For Output As #intFF ' (3) ' 2行目から開始 GYO = 2 ' 最終行まで繰り返す Do Until GYO > GYOMAX ' A列内容をレコードにセット(先頭は2行目) strREC = Cells(GYO, 1).Value ' (4) ' レコード件数カウンタの加算 lngREC = lngREC + 1 xlAPP.StatusBar = "出力中です....(" & lngREC & "レコード目)" ' レコードを出力 Print #intFF, strREC ' (5) ' 行を加算 GYO = GYO + 1 Loop ' 指定ファイルをCLOSE Close #intFF xlAPP.StatusBar = False ' 終了の表示 MsgBox "ファイル出力が完了しました。" & vbCr & _ "レコード件数=" & lngREC & "件", vbInformation, cnsTitle End Sub -----------------------------------------------------------------------------

  • Excelからテキストファイルを読み込み、読み込んだ行を削除する方法

    Excelからテキストファイルを読み込み、読み込んだ行を削除する方法 いつもお世話になりますm(__)m Excel2003のVBAで、以下のようにテキストファイルを読み込む処理を作成しています。 Sub LoadFile() Dim intFF As Integer Dim strFILENAME As String Dim DtC, DtD, DtE As String Dim GYO As Long strFILENAME = ActiveWorkbook.Path & "\sample.txt" If Dir(strFILENAME) <> "" Then intFF = FreeFile Open strFILENAME For Input As #intFF GYO = 1 Do Until EOF(intFF) Input #intFF, DtC, DtE, DtE If DtC = 1 Then GYO = GYO + 1 Worksheets("DataSheet").Range("C" & GYO).Value = DtC Worksheets("DataSheet").Range("D" & GYO).Value = DtD Worksheets("DataSheet").Range("E" & GYO).Value = DtE End If Loop Close #intFF End If End Sub sample.txtからデータを読み込み、1個目のデータが「1」なら、DataSheetのC,D,Eの各列に、テキストファイルから読み込んだデータがセットされます。 1個目のデータが1以外なら、DataSheetにはセットされないようにしています。 そこで、読み込んだデータ(1個目のデータが「1」の行)を読み込んでDataSheetに挿入した後に、その行をsample.txtから削除したいのですが、どうすればいいかわかりません(>_<) 最終的に、処理を実行した後のsample.txtは、DataSheetにセットしたデータ以外が残るようにしたいのです。 お詳しい方、何卒ご教授のほど宜しくお願い致しますm(__)m

  • FSOでテキストファイルのデータをエクセルに書き出

    FSOでテキストファイルのデータをエクセルに書き出すには? http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_040.html を参考に、 メモ帳の中身をエクセルに書き出そうとしてるのですが、 参考サイトを自分なりにアレンジしてみたのですが、何も書き出されません。 Sub WRITE_TextFile3() Const cnsFILENAME = "C:\Windows\PrimoPDF Setup Log.txt" Dim FSO As New FileSystemObject ' FileSystemObject Dim TS As TextStream ' TextStream Dim strREC As String ' 書き出すレコード内容 Dim GYO As Long ' 収容するセルの行 Dim GYOMAX As Long ' データが収容された最終行 ' 最終行の取得 GYOMAX = Cells(Rows.Count, "A").End(xlUp).Row ' 指定ファイルをOPEN(出力モード) Set TS = FSO.CreateTextFile(Filename:=cnsFILENAME, Overwrite:=True) ' 2行目から開始 GYO = 2 ' 最終行まで繰り返す Do Until GYO > GYOMAX ' A列内容をレコードにセット(先頭は2行目) strREC = Cells(GYO, 1).Value ' レコードを出力 TS.WriteLine strREC ' 行を加算 GYO = GYO + 1 Loop ' 指定ファイルをCLOSE TS.Close Set TS = Nothing Set FSO = Nothing End Sub そもそも、 ' 最終行の取得 GYOMAX = Cells(Rows.Count, "A").End(xlUp).Row で、なぜ最終行を取得するのかがわかりません。 書き出そうとしているシートには何も入ってないので、 GYOMAXは1になります。 そして、 ' 2行目から開始 GYO = 2 で、なぜ 2行目から開始から開始するのかわかりません。 ご回答よろしくお願いします。

  • エクセルのCSV読み込みについて

    現在,以下の記述でエクセル上にマクロ実行ボタンを作成しました。 任意のCSVファイルをエクセルに取り込み利用する目的です。 実行ボタンを押すと,「実行時エラー ファイルにこれ以上データがありません。」として,記述中の 「Input #intFF, X(1), X(2), X(3), X(4), X(5), X(6), X(7) ' (2)」 部分が黄色になって止まってしまいます。 エクセル画面上には,希望通りのデータが出力されているようなので,このエラーが表示されなければデータの取り込みとしては問題ないのですが・・・。 どのようにこのエラーを回避し処理すればよいかかが分かりません。 どなたかご教示いただければ幸いです。 どうかよろしくお願いいたします。 Sub Macro4() ' CSV形式テキストファイル(7カラム)読み込みサンプル Const cnsTITLE = "テキストファイル読み込み処理" Const cnsFILTER = "CSV形式ファイル (*.csv),*.csv,全てのファイル(*.*),*.*" Dim xlAPP As Application ' Applicationオブジェクト Dim intFF As Integer ' FreeFile値 Dim strFileName As String ' OPENするファイル名(フルパス) Dim vntFileName As Variant ' ファイル名受取り用 Dim X(1 To 7) As Variant ' 読み込んだレコード内容 ' (1) Dim GYO As Long ' 収容するセルの行 Dim lngREC As Long ' レコード件数カウンタ ' Applicationオブジェクト取得 Set xlAPP = Application ' 「ファイルを開く」のフォームでファイル名の指定を受ける xlAPP.StatusBar = "読み込むファイル名を指定して下さい。" vntFileName = xlAPP.GetOpenFilename(FileFilter:=cnsFILTER, _ Title:=cnsTITLE) ' キャンセルされた場合はFalseが返るので以降の処理は行なわない If VarType(vntFileName) = vbBoolean Then Exit Sub strFileName = vntFileName ' FreeFile値の取得(以降この値で入出力する) intFF = FreeFile ' 指定ファイルをOPEN(入力モード) Open strFileName For Input As #intFF GYO = 1 ' ファイルのEOF(End of File)まで繰り返す Do Until EOF(intFF) ' レコード件数カウンタの加算 lngREC = lngREC + 1 xlAPP.StatusBar = "読み込み中です....(" & lngREC & "レコード目)" ' レコードを読み込む(このサンプルは7項目のCSV) Input #intFF, X(1), X(2), X(3), X(4), X(5), X(6), X(7) ' (2) ' 行を加算しA~G列にレコード内容を表示(先頭は2行目) GYO = GYO + 1 Range(Cells(GYO, 1), Cells(GYO, 7)).Value = X ' 配列渡し ' (3) Loop ' 指定ファイルをCLOSE Close #intFF xlAPP.StatusBar = False ' 終了の表示 MsgBox "ファイル読み込みが完了しました。" & vbCr & _ "レコード件数=" & lngREC & "件", vbInformation, cnsTITLE End Sub

  • エクセル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 宜しくお願いいたします。

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

  • VBAの初心者でやりたいことがあるのですが、どうやっていいのか分かりま

    VBAの初心者でやりたいことがあるのですが、どうやっていいのか分かりません。 やりたいことは 1.フォルダを指定してCSVファイルを読み込む。 2.読み込んだCSVファイルを一行あたり1ファイルのエクセルファイルに書き込む。 3.完成したエクセルファイルを印刷する。 4.フォルダの中のファイルが無くなれば終了 としたいのですが、途中で頓挫しています。 宜しくお願いします。 Option Explicit sub READ_TextFile() Const cnsTITLE = "フォルダ内のファイル名一覧取得" Const cnsDIR = "\*.*" Dim xlAPP As Application Dim strPATHNAME As String Dim strFILENAME As String Dim GYO As Long Const cnsFILTER = "全てのファイル (*.*),*.*" Dim xlAPP2 As Application' Applicationオブジェクト Dim intFF As Integer' FreeFile値 Dim X() As Variant' 読み込んだレコード内容 Dim IX1 As Long' CSV項目カラムINDEX Dim lngREC As Long' レコード件数カウンタ Dim strREC As String' レコード領域 Dim POS1 As Long' レコード文字位置 Dim POS2 As Long' レコード文字位置 Set xlAPP = Application strPATHNAME = xlAPP.InputBox("フォルダ名を入力して下さい。", _ cnsTITLE, "C:\Documents and Settings\hidekazu_miyawaki\デスクトップ\") If StrConv(strPATHNAME, vbUpperCase) = "FALSE" Then Exit Sub If Dir(strPATHNAME, vbDirectory) = "" Then MsgBox "指定のフォルダは存在しません。", vbExclamation, cnsTITLE Exit Sub End If strFILENAME = Dir(strPATHNAME & cnsDIR, vbNormal) Set xlAPP2 = Application Do While strFILENAME <> "" GYO = GYO + 1 Cells(GYO, 1).Value = strFILENAME strFILENAME = Dir() Open strFILENAME For Input As #intFF GYO = 1 Do Until EOF(intFF) lngREC = lngREC + 1 xlAPP2.StatusBar = "読み込み中です(" & lngREC & "レコード目)" Line Input #intFF, strREC POS1 = 1 IX1 = 0 ReDim X(IX1) Do While POS1 <= Len(strREC) POS2 = InStr(POS1, strREC, ",", vbTextCompare) If POS2 < POS1 Then POS2 = Len(strREC) + 1 End If ReDim Preserve X(IX1) X(IX1) = Trim$(Mid$(strREC, POS1, POS2 - POS1)) If (((Left$(X(IX1), 1) = """") And (Right$(X(IX1), 1) = """")) Or _ ((Left$(X(IX1), 1) = "'") And (Right$(X(IX1), 1) = "'"))) Then X(IX1) = Trim$(Mid$(X(IX1), 2, Len(X(IX1)) - 2)) End If POS1 = POS2 + 1 IX1 = IX1 + 1 Loop GYO = GYO + 1 If IX1 >= 1 Then Range(Cells(GYO, 1), Cells(GYO, IX1)).Value = X End If Loop Loop Close #intFF xlAPP.StatusBar = False MsgBox "ファイル読み込みが完了しました。" & vbCr & _ "レコード件数=" & lngREC & "件", vbInformation, cnsTITLE End Sub

  • EXCEL VBAについて

    EXCEL VBAについて教えてください やりたいことは以下の通りです。 ・全シートJ列1~100行目を検索しアルファベットが含まれるセルが存在すれば 上のセルをコピーする ここまで作ったのですが上手くいきません Sub VBAsample() Dim GYO As Long For GYO = 1 To 100 If Find([a-z], LookAt:=xlPart) Then Cells(GYO, 10).Value = Cells(GYO - 1, 10).Value End If Next GYO End Sub 添削をお願いします

  • VBAで画像ファイルをダウンロードしたいけどうまく

    VBAで画像ファイルをダウンロードしたいけどうまく行かない・・・ XPで、オフィス2003です。 http://officetanaka.net/other/extra/tips01.htm を参考に、画像ファイルをダウンロードする練習をしているのですが "エラーが発生しました"になってしまいます。 標準モジュールに --------------------------------------------------------- Option Explicit Public Declare Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" (ByVal pCaller As Long, _ ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Sub Sample() GetImageFile "http://www.officetanaka.net/sample.jpg", "C:\sample.jpg" End Sub Sub GetImageFile(ImgName As String, SaveName As String) Dim SaveFileName As String, DownloadFile As String, Ret As Long Ret = URLDownloadToFile(0, DownloadFile, SaveFileName, 0, 0) If ImgName = "" Then Exit Sub SaveFileName = SaveName DownloadFile = ImgName Ret = URLDownloadToFile(0, DownloadFile, SaveFileName, 0, 0) If Ret = 0 Then MsgBox "ダウンロードできました" Else MsgBox "エラーが発生しました" End If End Sub --------------------------------------------------------- を貼り付けました。 Retが0にならなくてはいけないみたいですが、 自分の場合は、-2147221020になってしまいます。 どう修正すればいいのか教えてください。

専門家に質問してみよう