Excelからテキストファイルを読み込み、読み込んだ行を削除する方法
- Excel2003のVBAを使用して、Excelからテキストファイルを読み込み、特定の条件の行を削除する方法について教えてください。
- VBAを使用して、Excelからテキストファイルを読み込み、条件が一致する行を特定し、その行を削除する方法について教えてください。
- ExcelのVBAを使って、テキストファイルから読み込んだデータの中で、特定の条件に一致する行を削除する方法を教えてください。
- ベストアンサー
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
- osaka-aq
- お礼率64% (41/64)
- その他（プログラミング・開発）
- 回答数1
- ありがとう数3
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
削除することは出来ません。 方法は以下の２つのいずれかです。 （１）すべて読み込み残すべきデータを内部に記憶し、最後に同じファイル名で出力する。 （２）読み込む都度、残すべきデータを別名ファイルに出力し、最後にリネームする。
関連するQ&A
- ファイル書き出しのエクセルマクロ
試行錯誤でマクロを作っているのですが、エラーが出てしまいます。 コンパイルエラー 定数式が必要ですと出てしまいます。 Const cnsFILENAME = "C:\" & の ＆ で出ます。 どうすればいいのかお教えねがえませんでしょうか？ よろしくお願いします。 （帰りに本を買って帰ります。。。） 'テキストファイル書き出す Dim S5 As Worksheet Set S5 = Worksheets("TEMP") Const cnsFILENAME = "C:\" & S5.Range("D4") & ".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 ' 1行目から開始 GYO = 1 ' 最終行まで繰り返す Do Until GYO > GYOMAX ' A列内容をレコードにセット(先頭は2行目) strREC = Cells(GYO, 1).Value ' レコードを出力 Print #intFF, strREC ' 行を加算 GYO = GYO + 1 Loop ' 指定ファイルをCLOSE Close #intFF End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル 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 -----------------------------------------------------------------------------
- ベストアンサー
- オフィス系ソフト
- ファイル内容を変換後に別フォルダへコピーしたい
エクセルVBAにて 下記フォルダ状況となっている場合に C\元データ\複数のtxtファイル C\変換後データ 元のデータ内にあるtxtファイルの中身を変換し Open strFileName For Input As #intFF Do Until EOF(intFF) Line Input #intFF, strREC GYO = GYO + 1 Cells(GYO, 1).Value = 付け加えたい文字 + strREC Loop 変換したファイルを C\変換後データへコピーしたいのですが どのようししたらよろしいのでしょうか？ コピーしたファイル名は元のファイル名と同じにしたいです。
- 締切済み
- その他MS Office製品
- Excel VBA読み込みで文字化けが
Excel VBAにてメールデータを読み込むプログラムを組んでいます。 データの作り方は、 (1)Mozilla Thunderbirdでメールデータをtext形式で保存 (2)VBAにてtextデータを開く。 しかし読み込みを行うと、文字化けしたデータが表示されてしまいます。 どのように解決したらよいのでしょうか？ 文字コード変換を行ってもダメでした。 Sub Read_mail_data() Const cnsTITLE = "テキストファイル読み込み処理" Const cnsFILTER = "全てのファイル (*.*),*.*" 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 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 & "レコード目)" ' 改行までをレコードとして読み込む Line Input #intFF, strREC ' 行を加算しA列にレコード内容を表示(先頭は2行目) GYO = GYO + 1 ' 文字コードを変換する 'StrConv(strREC, vbFromUnicode) = a Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode) Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode) Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode) Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode) Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode) Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode) ' セルにデータを書き込む 'Cells(GYO, 1).Value = strREC Loop ' 指定ファイルをCLOSE Close #intFF xlAPP.StatusBar = False ' 終了の表示 MsgBox "ファイル読み込みが完了しました。 " & vbCr & "レコード件数=" & lngREC & "件", vbInformation, cnsTITLE End Sub
- ベストアンサー
- Visual Basic
- エクセルの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
- ベストアンサー
- Visual Basic
- 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
- ベストアンサー
- Visual Basic
- ExcelのマクロをAccessで動かすには…
今までExcelを使用していてVBAも段々と理解してきたのですが 今回Accessを使用することになって詰まってしまいました。 下のようなExcelのマクロ(VBA)があるのですが、 これをAccessでも同じように動かしたいのですがわかりません(汗) ----------------------------------------------- Sub テスト() Dim GYO As Long GYO = 1 Do Until Worksheets("テスト").Cells(GYO, 1).Value = "" If Worksheets("テスト").Cells(GYO, 1).Value >= 80 Then Worksheets("テスト").Cells(GYO, 2).Value = "合格" Else Worksheets("テスト").Cells(GYO, 2).Value = "不合格" End If GYO = GYO + 1 Loop End Sub ----------------------------------------------- これでAccessのレコード一つ一つの合否を入力する欄に 自動で入力されるようにしたいのですが、 Accessでの記述方法がよくわからないのです。(^_^;) お詳しい方、よろしくお願いしますm(_ _)m
- ベストアンサー
- その他(データベース)
- 複数のエクセルシートをまとめるマクロ
下は複数のエクセルファイルを一つにするマクロですが、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
- ベストアンサー
- Excel（エクセル）
- textデータをexcelに取り込む
VBA初心者です。 テキストファイルのデータをEXCELに自動取り込みしてcsv形式で保存したいのですが、テキストデータが65536行を超えているのでWorkbooks.OpenTextでは65537行以後が取り込めません。インターネットで調べた方法FileSystemObjectでテキストデータを1行ごとに取り込もうと思ったのですが、「ユーザー定義型が定義されていません」のエラーメッセージが表示されて旨くいきません。FileSystemObjectの使い方が良く解らないので誰か教えてください。 なお、テキストデータは1行に8フィールド有りますので、取り込んだデータはフィールドごとに8列に分けたいのですが、その方法も解りません。 テキストデータサンプル(1行分) 2004/1/5 101 i 10787 10862 10785 10825 726690000 以下に試みた方法を記述します。 Option Explicit Sub READ_TextFile3() Const cnsFILENAME = "D:\Test\test1.txt" Dim FSO As New FileSystemObject ' FileSystemObject Dim TS As TextStream ' TextStream Dim strREC As String ' 読み込んだレコード内容 Dim GYO As Long ' 収容するセルの行 Set TS = FSO.OpenTextFile(cnsFILENAME, ForReading) GYO = 1 Do Until TS.AtEndOfStream strREC = TS.ReadLine GYO = GYO + 1 Cells(GYO, 1).Value = strREC Loop TS.Close Set TS = Nothing Set FSO = Nothing End Sub
- ベストアンサー
- Visual Basic
お礼
ご回答有り難うございますm(__)m やっぱり無理なんですか(>_<) 方法を教えて頂いて有り難うございます。 いずれかの方法で処理したいと思います。 ありがとうございました(^-^)