txtファイルから特定の日時時刻だけexcel出力がしたい

Question

txtファイルから特定の日時時刻だけexcel出力がしたい

複数のLogをとったtxtファイルがあります。
txtファイルは日付毎に[C:\ユーザ\DATA]に格納されており、１つのtxtファイルから
3つの時刻を取り出します。最終的にはexcelに抽出したいとおもっています。

現在、フォルダ内.txtを一括grep→一行を抽出、シート出力まではマクロで作成して
おります。

例 ①Key:abc 抽出文:abc 2019/04/01 0:01:30 def
　 ②Key:ghi  抽出文:ghi 2019/04/01 0:00:05 jkl　　　　
  ③Key:opc 抽出文:opq 2019/04/01 0:00:30 rst


最終的な表示は以下のようにしたいとおもっています。

　　A　    B　　　    C　　　    D

1 　日時　　時刻1　　   時刻2　  　 時刻3

2 　4/1   0:01:30　　　0:00:05 　 　0:00:30

3 　4/2

4 　4/3


以上が現状と完成イメージです。
そこで抽出した文から時刻だけを取り出し、上記のように入力するマクロを作成した
いのですが構文が浮かびません。
アドバイス、例をいただけませんでしょうか。

根本の考え方から間違っていましたらご教示いただきたいです。

WindFaller · Accepted Answer

遅くなってすみません。一通り、出来上がりましたが、こういうのは、プレッシャーを感じてしまいます。しかし、ある程度、マクロが分かるのでしたら、アイデアだけ採用するという方法でもよいと思います。どのように振り分けるかはこーどを見ればわかるはずです。テキストファイルから追っていく方法は、見た目よりも難しいです。ある程度、決まったセルに出したものなら、出力後、関数でもよいのでしょう。インポートしたデータは、このようになっていると仮定しています。句切れは、スペースで分けられるようになっています。 cmjY JOI2 2019/04/01 05:05:01 abc fszZ JOI2 2019/04/02 05:05:02 abc frnM JOI2 2019/04/03 05:05:03 abc ▲　の部分が変わります。この場合は、2と3 mDate = Trim(arBuf(2))　'▲　区切りによって変わる　日付　3番目 mTime = arBuf(3)　　'▲　区切りによって変わる　時間4番目これから、1を引きます。 ▼テキストインポートまた、インポートの際に適当にデータを切ってしまうことも可能です。 ★の部分と、▲の部分は変更が必要です。 ----------------------------------------------- '元データファイル Const sFILE As String = "D:\Data\Sample1.txt" ''★データ '検索値 Const SrchDATA As String = "abc,ghi,opq" 　''★Key 　'余計なスペースが入らないように! Sub ImportData() 　''*****Text Import******* 　Dim Fname As String 　Dim TextLine As String 　Dim i As Long, j As Long, k As Long, x As Long 　Dim buf 　Dim srcVal 　Dim arBuf 　Fname = sFILE 　If Application.CountA(Cells) > 1 Then 　　If MsgBox("シートのデータを消します。", vbOKCancel) = vbCancel Then Exit Sub 　End If 　ActiveSheet.UsedRange.ClearContents 　If Dir(Fname) = "" Then MsgBox "元のデータが見つかりません。", vbCritical: Exit Sub 　For Each srcVal In Split(SrchDATA, ",") 　　x = Cells(Rows.Count, 1).End(xlUp).Row + 1 '最終行+1 　　Open Fname For Input As #1 　　Do While Not EOF(1) 　　　Line Input #1, TextLine 　　　If InStr(1, TextLine, srcVal, vbTextCompare) > 0 Then 　　　　buf = TextLine '▼テキストインポート　　　　Do 　　　　 buf = Replace(buf, Space(2), Space(1), , , vbTextCompare) 　　　　 DoEvents 　　　　 Loop Until InStr(1, buf, Space(2), vbTextCompare) = 0 　　　　Cells(x + j, 1).Value = buf 　　　　j = j + 1 　　　End If 　　　DoEvents 　　Loop 　　j = 1 　　Close #1 　Next End Sub '------------------------- Sub Get3dataAday() 　Dim arBuf 　Dim mDate As Variant 　Dim mTime As Variant 　Dim itmIndex As Variant 　Dim Rng As Range, c As Variant ''　Dim dic As Object ''　Set dic = CreateObject("Scripting.Dictionary") '今回は取りやめ　Dim i As Long, j As Long 　Dim rw As Variant 　Dim sh2 As Worksheet 　Set sh2 = Worksheets("Sheet2") '★シート設定　If Application.CountA(sh2.Cells) > 1 Then 　 If MsgBox(sh2.Name & "のデータを削除してよろしいいですか？", vbOKCancel) = vbCancel Then Exit Sub 　 sh2.Cells.ClearContents 　 End If 　itmIndex = Split(SrchDATA, ",") 　Set Rng = Range("A2", Cells(Rows.Count, 1).End(xlUp)) 'A列2行目より　For Each c In Rng 　　If c.Value <> "" Then 　　　For j = 0 To UBound(itmIndex) 　　　　If InStr(1, c.Value, itmIndex(j), 1) > 0 Then 　　　　　Exit For 　　　　End If 　　　Next 　　　If j <= UBound(itmIndex) Then 　　　　arBuf = Split(c.Value, Space(1)) ''C:\User\logフォルダ\.log(対象ファイル名) ipuin　JOI2 2019/04/01 05:15:01 opq 　　　　mDate = Trim(arBuf(3))　'▲　区切りによって変わる 4番目　　　　mTime = arBuf(4)　　'▲区切りによって変わる　5番目　　　　With sh2 　　　　　rw = Application.Match(CDate(mDate) * 1, .Range("A:A"), 0) 　　　　　If IsNumeric(rw) Then 　　　　　　.Cells(rw, 1).Value = mDate 　　　　　　.Cells(rw, j + 2).Value = mTime 　　　　　Else 　　　　　　rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1 　　　　　　.Cells(rw, 1).Value = mDate 　　　　　　.Cells(rw, j + 2).Value = mTime 　　　　　End If 　　　　End With 　　　End If 　　End If 　Next 　sh2.Cells(1, 2).Resize(, 3).Value = itmIndex MsgBox "終了しました。", vbInformation End Sub '// 時系列に出てこない場合は、この後に日付でソートを掛けます。

fujillin · Answer

こんにちはお求めではないかも知れませんが、マクロ等を使用しない方法の例をご参考までに。 txtファイルの内容が、補足でご提示のようなものとすれば、エクセルから直接テキストファイルとして開いて、スペースを区切り文字として指定すると、添付図左側（A～D列）のように読み込めるはずです。これに対して、別シート等に予め関数式を設定しておけば、読み込んだ時点で結果に反映されるようになります。添付図では、添付の関係で別シートではなく同じシートのF列以降に関数を設定してありますが、別シートにしておくほうが便利そうな気がします。図では、A～D列のデータをファイルから読み込んだデータとし、F1セルには =IFERROR(AGGREGATE(15,6,INDEX($B$1:$B$80/(COUNTIF(OFFSET($B$1,0,0,ROW($B$1:$B$80),1),$B$1:$B$80)=1),,),ROW(A1)),"") の式を入れ下方にフィルコピー G1セルに =IFERROR(IF(INDEX($C$1:$C$80,AGGREGATE(15,6,INDEX(ROW($B$1:$B$80)/($B$1:$B$80=$F1)/($F1<>""),,),COLUMN(A1)))="","",INDEX($C$1:$C$80,AGGREGATE(15,6,INDEX(ROW($B$1:$B$80)/($B$1:$B$80=$F1)/($F1<>""),,),COLUMN(A1)))),"") の式を入力し、右方、下方にフィルコピーしています。 ※ 別シートに結果を出すようにしておけば、元データを入れ替えると即時に結果に反映されます。 ※ 実は、空白（データが無い部分）を空白表示させるのに式が長くなっています。　　（00:00:00表示でもよければ、半分くらいの長さになります）

WindFaller · Answer

>上記のようにlogがなかった箇所は空白にしたい、A行の日付に合った時間を格納したい、のですがこの点でつまっております。

それは想定済みです。ただ、こちらから、忖度して作った時に、そうでなかった場合の落胆度は、落差が大きいので書かなかったのです。

>各txtの内部例です。
>abc 2019/04/01 0:01:30 def
>abc 2019/04/02 0:01:35 def
>abc 2019/04/04 0:01:20 def
>abc 2019/04/05 0:01:30 def

>上記条件でtxtをインポートしながら表へ格納する方法をご教授いただけないでしょうか。
grep でどう抜き出しているかは分かりませんが、VBAの中で、ほぼgrepの替りにはなります。そこのパターンが必ず出てくるなら、そのまま取れます。いままで経験で、できるとは思うのです。ただ、私の失敗例では、テキストファイルにみえて、テキストファイルではなくて、特殊なファイル(シーケンシャルファイルど)であることが相談者さんが、分からなかった場合です。だから、この種の質問の成功率は、2割り程度です。

grep は、正規表現をお使いなのですか?　それとも、keyの単語で一行抜き出ししているとか。

生の最初の元のTextデータが分かると確実なのですが。

>2 　2019/04/01　　0:01:30　　　0:00:05 　 　0:00:30
1日のデータが3つごと。これは分かります。
元は、

abc 2019/04/01　0:01:30 def
abc 2019/04/01　0:00:05 def
abc 2019/04/01　0:00:30 def

>3 　2019/04/02　　0:01:35　　　　　　　　　 0:00:45
1日のデータで、真ん中が抜ける要因は、何でしょうか。

abc 2019/04/02　0:01:30 def
abc 2019/04/02
abc 2019/04/02　0:00:30 def

でしょうか?

それとも、日付はバラバラに出てきているのでしょうか。
できましたら、不要な部分、隠すべきところは、ぼかしてもよいので、元のデータの、3つ揃えられるもの、そうでないものを、画像データでも、何かでも、生に近いものを見せていただくわけにはいきませんか?　今の所、私としては、確信が持てないのです。

すみません、できると言いながら、突っ込んで考えると、まだわからないことが一杯なのです。

WindFaller · Answer

>現在、フォルダ内.txtを一括grep→一行を抽出、シート出力まではマクロで作成して
おります。

そこまでできるのでしたら、その後も、マクロできるはずです。
ただ、grepで標準出力したものを拾うよりも、インポートしながら、データをシートに置くほうが楽かもしれませんね。しかし、インポートしながらでは、スピードに問題がありそうです。

今回、事情が分からないので、固定位置のデータ3個を取る方式にしました。
だから、取れないときは、セルが空白になります。
しかし、今回は、日付のチェックがなされていません。

まず、
Set sh2 = Worksheets("Sheet2")　　'シート2の登録
を設定してから、アクティブシートにデータを置いて実行してください。
なお、シート上のデータがA列に寄せられていることを条件にしていますから、切り分けたものですと、書き換えなくてはなりません。

'//標準モジュール
Sub RegPicker()
　Dim RegEx As Object
　Dim Ms, m
　Dim buf As String
　Dim i As Long, j As Long, c As Variant
　Dim ret1(2), ret2(2)
　Dim sh2 As Worksheet: Set sh2 = Worksheets("Sheet2")　　'シート2の登録
 
　Set RegEx = CreateObject("VBScript.RegExp")
　With RegEx
　　.Global = True: .IgnoreCase = False: .MultiLine = True
　　.Pattern = "(\d{4}/\d\d/\d\d)\s(\d+:\d\d:\d\d )"
 
　　j = 2 '出力値のスタート行数
 
　　For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
　　　buf = c.Value
　　　Set Ms = .Execute(buf)
　　　If Ms.Count > 0 Then
　　　　ret1(i) = Ms(0).subMatches(0)
　　　　ret2(i) = Ms(0).subMatches(1)
　　　　'日付の狂いはチェックしていない
　　　Else
　　　 '' i = 0: Erase ret1: Erase ret2 '不揃いでも3個のデータを求めるので、獲得したデータは消さない
　　　End If
　　　If i = 2 Then
　　　　sh2.Cells(j, 1).Value = ret1(0)
　　　　If sh2.Cells(j, 1).Value = "" Then sh2.Cells(j, 1).Value = ret1(1)
　　　　sh2.Cells(j, 2).Resize(, 3).Value = ret2
　　　　Erase ret1
　　　　Erase ret2
　　　　j = j + 1
　　　　i = -1
　　　End If
　　　i = i + 1
　　Next
　End With
　'フォーマット
　With sh2
　　.Range("A1:D1").Value = Array("日時", "時刻1", "時刻2", "時刻3 ")
　　.Range("A1:D1").HorizontalAlignment = xlCenter
　　.Range("A2", .Cells(Rows.Count, 1).End(xlUp)).NumberFormatLocal = "m/d"
　　.Range("B2", .Cells(Rows.Count, 1).End(xlUp).Offset(, 3)).NumberFormatLocal = "h:MM:ss"
　　MsgBox "終了", vbInformation
　End With
End Sub

presidio · Answer

find文とかmid文，right文，left文などを使えば取り出せますよね。例えば日付なら（A10に文字列が入っているとして）
=MID(A10,FIND("/",A10)+1,5)
ですね。
時刻は上の文と同様にしますが，３番目の引数に開始位置を指定します。開始位置は/から行けば良いですね。
=MID(A10,FIND(" ",A10,FIND("/",A10)),8)
ただし，日付の前に/がないことが条件です。とにかく，日付の最初と長さをどうやって取り出すかです。

txtファイルから特定の日時時刻だけexcel出力がしたい

遅くなってすみません。

こんにちは

>上記のようにlogがなかった箇所は空白にしたい、A行の日付に合った時間を格納したい、のですがこの点でつまっております。

>現在、フォルダ内.txtを一括grep→一行を抽出、シート出力まではマクロで作成して

find文とかmid文，right文，left文などを使えば取り出せますよね。

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング