No.1
- 回答日時:
VBAでよろしいのでしょうか?
txtファイルやcsvファイルの抽出は、VBAでは必要に迫られる事が多く、
ある程度のスキルの方は、皆さんご存知かと思います。
テキストファイルやCSVファイルの抽出は、以外に奥が深いです。
情報や回答が付かないのは、皆さんは、どの様なテキストか分からない為と思われますよ。
通常?、テキストファイルをExcelシートに読み込む(抽出)時は、セルに分割?しデータとして
活用する事が多いですね。したがって、カンマ区切りのTxtファイルとか、タブ区切りとか
使用目的とか知りたいのではないでしょうか?
連続して、最終行以降に追記して行く事はVBAでは、難しい事ではありません。
読み込みは、ファイルシステムオブジェクトのFSO.OpenTextFileとか、、方法は、色々あります。
1行単位でA列に抽出するだけであれば、容易です。
あなたの言う理想をもう少し具体的に示してください。
そうすれば、有益な情報が得られると思いますよ。。。
No.2
- 回答日時:
こんにちは
内容的に不明な点が多いけれど、サンプルがあれば良いのなら多少はそれっぽいかも。
Sub Sample()
Dim wb As Workbook
Dim ds As Worksheet
Dim sr As Range
Dim rw As Long, rwMax As Long
Dim fName As String
Dim flg As Boolean
const folderPath = "D:\"
Set ds = ActiveSheet
ds.Cells.ClearContents
ds.Cells.UnMerge
fName = Dir(folderPath & "*.txt")
rwMax = 1
flg = True
Application.ScreenUpdating = False
While flg And fName <> ""
ds.Cells(rwMax, 1).Value = "◆◆ file name: " & fName
rwMax = rwMax + 1
Workbooks.OpenText Filename:=folderPath & fName, _
DataType:=xlDelimited, Comma:=True, Space:=True, Tab:=ture
Set wb = ActiveWorkbook
Set sr = ActiveSheet.UsedRange
If rwMax + sr.Rows.Count >= Rows.Count Then
MsgBox "行数溢れのため中断します"
flg = False
Else
sr.Copy Destination:=ds.Cells(rwMax, 1)
rwMax = rwMax + sr.Rows.Count
End If
wb.Close SaveChanges:=False
fName = Dir()
Wend
Application.ScreenUpdating = True
MsgBox "終了"
End Sub
※ 後出しじゃんけんは嫌いなので、後は適当にどうぞ。
No.3
- 回答日時:
自分のテキストファイルで試しにやってみました。
>1シートに連続して最終行を取得し張り付けたい
「最終行のみ」という解釈です。
一応、サンプルまでです。現実は、そんなに簡単にはいかないかもしれません。
また、ReadAllを使っている以上、ファイルの大きさにより、メモリ限界があります。
'//標準モジュール
Sub CheckLstline()
Dim objFS As Object
Dim objText As Object
Set objFS = CreateObject("Scripting.FilesystemObject")
Dim FName As String, MyPath As String
MyPath = "D:\Data\Text" '必ず末尾には、¥を忘れないこと
Dim myArray '配列要変数
Dim i As Long
ReDim myArray(2000) 'ファイルの限界数=2000
Dim arBuf
Dim buf As String
Dim j As Long, n
FName = Dir(MyPath & "*.txt", vbNormal) 'Dirリスト
Do While FName <> ""
If FName <> "." And FName <> ".." Then
If (GetAttr(MyPath & FName) And vbNormal) = vbNormal Then
myArray(i) = FName
i = i + 1
If i > UBound(myArray) Then Exit Do '限界数
End If
End If
FName = Dir
Loop
For Each n In myArray
If n <> "" Then
Set objText = objFS.OpenTextFile(MyPath & n) 'shift-jis
'Set objText = objFS.OpenTextFile(MyPath & n, , , -1) 'unicode
arBuf = Split(objText.ReadAll, vbCrLf) ''Return Code =Cr+Lf
buf = arBuf(UBound(arBuf))
j = j + 1
Cells(j, 1).Value = buf '出力データ
objText.Close
buf = ""
If j > i Then Exit For 'j は行数、i は配列index+1 --出力数調整可能
End If
Next n
End Sub
No.4
- 回答日時:
こんにちは、dat拡張子のファイルについては、ご存知の事と思います。
余計な説明は割愛しますがファイルの内容によっては、文字化けや抽出できない場合もあります。
>このエクセルマクロでdatファイルも同じように複数ファイルを連続読み込みしたいのですが区切りもなく
そのままの取り込み方法も教えていただけないでしょうか?
参考まで
コメント部分のコードは、デバック、テスト時に使用したコードです。
テストする時に活用してください。
新規Bookでテストしてください。
Sub dat_import()
Const Record_length = 600
Dim Records_count As Long
Dim Record(Record_length - 1) As Byte
Dim i As Long, j As Long, FirstRow As Long, n As Long
Dim Folder_Path As String, f As Object
Dim Extension As String, ArrFile() As String
' Dim File_Name As String, first_path As String
' On Error Resume Next
Extension = "dat"
FirstRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
'シートの一行目は、見出し行(又は空白)になります。
Folder_Path = "D:\"
' first_path = CreateObject("WScript.Shell").SpecialFolders("desktop")
' With Application.FileDialog(msoFileDialogFolderPicker)
' .InitialFileName = first_path
' If .Show = True Then
' Folder_Path = .SelectedItems(1) & "\"
' End If
' End With
' If Folder_Path = "" Then Exit Sub
With CreateObject("Scripting.FileSystemObject")
For Each f In .GetFolder(Folder_Path).Files
If LCase(.GetExtensionName(f)) = Extension Then
i = i + 1
ReDim Preserve ArrFile(i)
ArrFile(i) = f.Name
End If
Next f
End With
n = FreeFile
For j = 1 To UBound(ArrFile)
Open Folder_Path & "\" & ArrFile(j) For Binary As n
Records_count = (LOF(1) / Record_length)
For i = 1 To Records_count
Get n, , Record
Cells(FirstRow, 1).Offset(i - 1).NumberFormatLocal = "@"
Cells(FirstRow, 1).Offset(i - 1).Value = StrConv(Record, vbUnicode)
Next i
Close n
Cells.WrapText = False
Next
End Sub
Const Record_length = 600 ’レコード数の設定です。目的に合わせ変更してください。
Binaryで抽出し、vbUnicode(Windowsのみ)で書き出しています。
対象のdatファイルの内容により、変更が必要かもしれません。
Open ステートメントBinaryについて https://docs.microsoft.com/ja-jp/office/vba/lang …
StrConv 関数について https://docs.microsoft.com/ja-jp/office/vba/lang …
>MIDB関数で区切ってます
これもどの様なByte区切りか気になりますが、、
他の形式については、すでにコードもあるので、、
不明な点がありましたら、補足でお願いします。
No.5
- 回答日時:
#4の訂正をさせてください。
しっかり検証しなかった事を悔やんでます。再確認してよかったです。下記に訂正コードを示します。
Option Explicit
Sub dat_import()
Dim i As Long
Dim Folder_Path As String, f As Object
Dim Extension As String, ArrFile() As String
' Dim File_Name As String, first_path As String
' On Error Resume Next
Extension = "dat"
Folder_Path = "D:\"
' first_path = CreateObject("WScript.Shell").SpecialFolders("desktop")
' With Application.FileDialog(msoFileDialogFolderPicker)
' .InitialFileName = first_path
' If .Show = True Then
' Folder_Path = .SelectedItems(1) & "\"
' End If
' End With
' If Folder_Path = "" Then Exit Sub
With CreateObject("Scripting.FileSystemObject")
For Each f In .GetFolder(Folder_Path).Files
If LCase(.GetExtensionName(f)) = Extension Then
i = i + 1
ReDim Preserve ArrFile(i)
ArrFile(i) = f.Name
End If
Next f
End With
Call File_write(Folder_Path, ArrFile)
Cells.WrapText = False
End Sub
Sub File_write(Folder_Path, ArrFile)
Const Record_length = 500
Dim i As Long, j As Long, FirstRow As Long, n As Long
Dim Record(Record_length - 1) As Byte
Dim Records_count
FirstRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 'シートの一行目は、見出し行(又は空白)になります。
n = FreeFile
With ThisWorkbook.Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
For j = 1 To UBound(ArrFile)
Open Folder_Path & "\" & ArrFile(j) For Binary As n
Records_count = (LOF(1) / Record_length)
For i = 1 To Records_count
Get n, , Record
Cells(FirstRow, 1).Offset(i - 1).NumberFormatLocal = "@"
Cells(FirstRow, 1).Offset(i - 1).Value = StrConv(Record, vbUnicode)
Next i
Close n
FirstRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Next
With ThisWorkbook.Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
End Sub
すみません。
No.6
- 回答日時:
datファイルの一行目の意味が分かりません。
Byteでなくて良いのですか?それ、dat?txtって書いてあるし、
どんなデータが入ってるの?普通にTxtやCsvに変更できるファイルなのですか?
txtで読めるの?
そもそも引っ掛かっていた事を指摘しますが、
今使ってるのはtxt,dat,csvの選択式です。
同じルーチンを通すつもり?
別物ですよね。
後出しじゃんけんヤダと言ってますし、
つまり無知な質問に付き合えないか、後からやりたい事を
ヒントを得てから構想するやからに付き合えませんよ
>素人なのでドライブ変更ぐらいしかできません
自覚があるなら、するべきことは、他にあるのでは?
ご質問のそれが出来ても、どうせ活用できないし、
勉強してから質問しなさい。理解できないでしょし、
No.7
- 回答日時:
K-Z900RS様
#6に関して、論調が不適切で申し訳ありませんでした。
データファイルについては、幅が広くその仕様により様々です。単純にテキストとして抽出できるものとは理解しておりません。
ただ、Excelに取得されることを前提に作られたものであれば、正しく抽出する事も成形する事も、もちろん可能ですね。
であれば、dat拡張子のものもレコード(Byte)単位でなく行単位が良いでしょう。従って、txt同様のプロセスで抽出できると思います。
一応、ご理解いただきたいのは、
>タブ、カンマ、一つ以上の空白、の選択式で取り込んでいます
>txtファイルの内容はタブ区切りで100行ほどdatファイルは不規則なスペース区切りですが全角,半角,記号,スペースで200桁ぐらいで
>エクセルに取り込んだ後にMIDB関数で区切ってます
とあるので、その部分(データ処理)は、すでに出来ており、理解されていると解釈してファイル読み込み部分を回答されているのだと思います。
また、CSV、TXTファイルの抽出方法はプログラムをする方の経験や好み、仕様も関係します。また、ADODBを活用したり、、、多くの方法があります。
なので、私はめんどくさい(後からこうしたいああしたい、出来るけど、、発生率高い)ので、明確でないと回答しにくいですね。
>いろいろ探してみてるのですが理想のサンプルがありません
そんなはずは、ないと思いますよ。
昔、作った物の寄せ集めですが、ご希望の処理は出来るかとコード内の Replaceで仕様に合わせてください。
txtファイルカンマ区切り専用です。該当処理を変えれば、色々出来るかと思います。
TS.ReadAllで処理しようかとも思いましたが、これも一行目はいらないとのことでやめました。処理は数十倍以上遅くなります。
CSVも作ろうかと思いましたが、
>一つ以上の空白、の選択式で取り込んでいます
の意味が解らないので、やめました。
おそらく、このサンプルも理想のサンプルではないと思いますが、、シンプルな流れにしましたので学習できるかと思います。
(時間の関係上、寄せ集めなので変な個所がありますが、問題なく処理されるかと)
Option Explicit
Sub CSV_Extraction_comma()
Dim FSO As FileSystemObject ' Microsoft Scripting Runtime 参照
Set FSO = New FileSystemObject
Dim TS As TextStream
Dim i As Long, GYO As Long, S As Long, FG As Long
Dim strREC As String '読み込みテキスト 行データ
Dim tx_val As Long, tmp As Variant
Dim Folder_Path As String, f As Object
Dim first_path As String, Extension As String, St_Name As String
Extension = "txt"
St_Name = ActiveSheet.Name '"Sheet1"
first_path = "D:\" 'CreateObject("WScript.Shell").SpecialFolders("desktop")
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = first_path
If .Show = True Then
Folder_Path = .SelectedItems(1) & "\"
End If
End With
If Folder_Path = "" Then Exit Sub
With FSO
For Each f In .GetFolder(Folder_Path).Files
FG = 0
If LCase(.GetExtensionName(f)) = Extension Then
Set TS = FSO.OpenTextFile(Folder_Path & f.Name, ForReading)
GYO = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Do Until TS.AtEndOfStream
strREC = TS.ReadLine
strREC = Replace(Replace(Replace(Replace(strREC, vbLf, ""), " ", ""), """", ""), vbCr, "")
S = 0
If FG > 0 Then
If InStr(strREC, ",") > 0 Then
For i = 1 To Len(strREC) 'カンマ区切りデータ限定
If Mid(strREC, i, 1) = "," Then S = S + 1
Next i
For tx_val = 0 To S
ReDim tmp(tx_val)
tmp = Split(strREC, ",")
Cells(GYO, tx_val + 1).Value = tmp(tx_val)
Next tx_val
Else
End If
GYO = GYO + 1
End If
FG = FG + 1
Loop
End If
Next f
End With
TS.Close
Set TS = Nothing
Set FSO = Nothing
End Sub
No.8
- 回答日時:
すみません。
遅延(実行時)にバインディングにしようか迷ったのですが、、
参照設定は、こちらを参考にしてみてください。
https://www.atmarkit.co.jp/ait/articles/1703/14/ …
No.9ベストアンサー
- 回答日時:
Sub dat_import()の場合
' On Error Resume Next を On Error Resume Next ’を削除
Sub CSV_Extraction_comma()の場合
Dim first_path As String, Extension As String, St_Name As String
On Error Resume Next を追加
Extension = "txt"
アラートは出ませんが、止まる事もなくなります。
バインディングで躓くのだから、おそらく何も分からないと思いますが、
>後輩たちに引き継ぐ際に
そのように思うなら、追加するコードなど他にもありますよ。
あなたの為に付けてないのですよ。分かりますか。
いずれにしても、あなたが、ここに質問する語句をそのままGoogle先生に聞いて
自らが理解してデバックしながら作らないと、知識を得ることは出来ません。
>いろいろ探してみてるのですが理想のサンプルがありません
それは、あなたに理想がないからだと理解出来ました。
なかなかいいバイクですよね。KZ900SR デモ体力的にもう乗れません。
Qchan1962さん
本当にありがとうございました
なかなか覚えれなく 記憶にも残りにくくて苦労してます(^^♪
説明も下手でお手数おかけしました
本当に助かりました 数年の悩みがやっと解決しました
感謝しかありませんm(_ _"m)
バイクいいですよ 通勤とツーリングに使ってます
最後のバイクになるでしょうけど 気に入って乗ってます
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- その他(プログラミング・Web制作) Windowsのマクロプログラムで、こんなことできますか? 3 2022/06/28 14:30
- Excel(エクセル) エクセル マクロ テキストファイルを取り込む 複数の区切り文字で別々のセルに格納するには? 3 2022/08/10 21:10
- Visual Basic(VBA) 貼り付けた値が消えていく 以下はソースファイルの2番目のシートのB6から最終行を取得 ターゲットファ 2 2023/07/27 12:23
- Visual Basic(VBA) マクロVBA 1シートをまとめる 閉じ方 初心者 SOS! 1 2022/06/17 14:54
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/07/16 14:36
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/07/15 16:33
- Visual Basic(VBA) 最終行の指定について教えてください。 複数シートを1シートへまとめる下記マクロでは各シートの6行目を 1 2022/10/04 18:37
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/08/08 11:02
- Excel(エクセル) 【VBA】指定フォルダに格納中のテキストファイルをエクセルで処理し結果のエクセルを新規フォルダに保存 1 2022/03/25 14:19
- 会社・職場 新婚旅行での有給取得について 3 2023/02/09 01:04
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教えるわが家の防犯対策術!
ホームセキュリティのプロが、家庭の防犯対策を真剣に考える 2組のご夫婦へ実際の防犯対策術をご紹介!どうすれば家と家族を守れるのかを教えます!
-
複数のテキストファイルをエクセルに一括で取り込みたい
Excel(エクセル)
-
複数のテキストファイルを一括でエクセルに取り込みたい。
Excel(エクセル)
-
複数のテキストファイルをexcelでそれぞれ別シートに書き出したい
Excel(エクセル)
-
-
4
(Excelマクロ)datファイルをエクセルに読み込みたい
Excel(エクセル)
-
5
マクロを使ってフォルダー内にあるtxtデータをエクセルにデータに変換する方法をご教授願います
Excel(エクセル)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【CSVファイル】先頭の文字列に...
-
100万行のCSVを10万行ずつのフ...
-
アクセスでcsvに出力した際、頭...
-
ファイル名が同じ場合自動的に...
-
複数のテキストファイルをエク...
-
Access2007のエキスポートについて
-
AS/400からOracle...
-
Filemakerで、PC上ファイルの存...
-
タブ区切りデータからダブルコ...
-
Access インポート
-
カンマ区切りで取得
-
csvファイルが保存すると数...
-
Accessで小数点以下を切り捨て...
-
エクセルデータをテキストファ...
-
Accessでdatファイルのインポート
-
PSV形式ファイルをAccessにイン...
-
TXTで作成したファイルをDATフ...
-
ThunderbirdのメールをCSVでま...
-
csvファイルをAccessに取り込む...
-
【Excel】[Expression.Error] ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【CSVファイル】先頭の文字列に...
-
100万行のCSVを10万行ずつのフ...
-
Access インポート
-
アクセスでcsvに出力した際、頭...
-
ThunderbirdのメールをCSVでま...
-
Access2007のエキスポートについて
-
タブ区切りデータからダブルコ...
-
カンマがデータとして入ってるC...
-
TXTで作成したファイルをDATフ...
-
csvファイルが保存すると数...
-
Access95のエクスポートで教え...
-
ファイル名が同じ場合自動的に...
-
accessで項目内の文字を自動改...
-
エクセルデータをテキストファ...
-
任意のCSVファイルをAccessに取...
-
Accessでdatファイルのインポート
-
CSVファイルのセルに「01」と入...
-
Accessで小数点以下を切り捨て...
-
CVS形式とは?
-
csvファイルをAccessに取り込む...
おすすめ情報
VBAでお願いします
今使ってるのはtxt,dat,csvの選択式です
タブ、カンマ、一つ以上の空白、の選択式で取り込んでいます
txtファイルの内容はタブ区切りで100行ほど
datファイルは不規則なスペース区切りですが全角,半角,記号,スペースで200桁ぐらいで
エクセルに取り込んだ後にMIDB関数で区切ってます
エクセルバージョンは2010以降ということでお願いします
OSはWin 7 10 で使用します
説明不足ですみませんでした
これでも不足かもしれませんがよろしくお願いします
こんにちは
WindFallerさん fujillinさん ありがとうございます
fujillinさん 質問ですがコンマ区切りの途中でスペースがあると スペース区切りされてしまいます
完全コンマ区切りでやりたいのでコードお願いします
あと ファイル名は不要でテキストの2行目からを取り込み
テキスト2とくっつけたいのでコードを教えていただけないでしょうか?
数字を変えてみたのですがわかりませんでした 教えていただけないでしょうかよろしくお願いします
また このエクセルマクロでdatファイルも同じように複数ファイルを連続読み込みしたいのですが
区切りもなくそのままの取り込み方法も教えていただけないでしょうか?
よろしくお願いします
ありがとうございます
コンマ区切りでの取り込みをしたいのですがtxtファイルの2行目からをインポートして
最終行の次の行に2ファイル目の2行目を張り付けるようにお願いします
テストした結果は1行目の最後に2行目がくっついて取り込まれてしまってます
どこを変更するのかわかりません
どうかよろしくお願いします
こんにちはdatファイルの1行目はタイトル行といえばよいでしょうか!
2行目からをインポートしたいデータです
複数データをインポートしてつなぎ合わせるのにタイトル行は邪魔になります
現在使わせていただいてるのはdat,txt,csvの切替えとtab,コンマ、スペースを切替えて使うように
エクセルにに組み込んであるものです
なので同じvbaでdat,txtができるものだと思ったのです(素人考えでした)
エクセルに選択できるように作りこまれたものだったのですね
データはコンマ区切りでセルに取り込みたいのですが連続で取り込まれます
それに2行目の最後に3行目が繋がっています
3行目からはセル内で改行されてるものもあります
行の最終桁で改行させたいのですがうまくいきません
datの方は何となく解決しました
数は行でバラバラです
txtファイルのコンマ取り込みを教えていただけないでしょうか?
Qchan1962さん
いつも ありがとうございます
作っていただいたものを
標準モジュールに貼り付けてもsheet1に貼り付けてもコンパイルエラーで
動いてくれません
ヘルプ自体もむつかしく 理解できません
Microsoft Scripting Runtime この項目があるので
レジストリーなどをいじる必要とかあるのでしょうか?
動いてくれればいろいろいじることもあるのですが
無知ですみません
おいそがしいところ申し訳ありませんがもう少しお付き合いお願いします
何卒宜しくお願い致します。
Qchan1962さん
本当にありがとうございます
動くようになり取り込みもできるようになりました
とても感激です
気になるのが作っていただいた下記の2つのプログラムですが
Sub dat_import()
Sub CSV_Extraction_comma()
フォルダにデータがなかった場合にデバックが出てしまいます
回避法はありますか?
データがありません的なメッセージとかが出るようになれば
プログラムを壊すこともなくなると思うのですが
後輩たちに引き継ぐ際にも安心できるようにしておきたいと思います
いろいろお願いばかりで申し訳ありません
何卒よろしくお願い申し上げます。