excel時間データを抽出＋countifsの応用

質問

(1)
●● XX 12:00 △△　■■　★★　＊＊
○○ XX 00:04 ▲▲　□□　☆☆　＊＊
○● XX 23:34 △▲　□□　★☆　＊＊
・
・
という様なデータがあります。
23:00台～05:00台までの1時間ずつの、７つの枠に分け、上記データ（横一列が１データ）から必要な情報だけ別シートに表示させたいです。
例）
23:00台
23:34 △▲　○● XX　★☆
00:00台
00:04 ▲▲　○○ XX ☆☆

(2)
条件のセル　A1セルにDと入力してある。

↓最後のセルを表示 ↓１文字１セル　↓数字　
E　　　 ABCDE　　　　　　 ２
W　　　 EXRDW　　　　　 １
D　 JOWPRD　　　　　 ２
N　 　DUQKLN　　　　　 ３

上記のようなデータがあります。
横一列のデータを1データとみて、最初と最後の文字（＝セル）以外で、
条件のA1セル（D)があれば、右端の数字を足し算したい。

e.g. 条件がD、両端の数字はカウントしないので、答えは２＋１です。

本当に困っています。。。宜しくお願い致します。

回答No.1

eden3616

(1)、(2)の二つともVBAで処理致します。

①Alt+F11でVBEを開く
②挿入→標準モジュールを選択して新規標準モジュールを作成
③下記のVBAコードを貼付
④右上の×または、Alt+F11でVBEを閉じる
⑤Alt+F8または、表示→マクロから「sample1」または、「sample2」を実行

▼マクロの動作について

「sample1」は、ご提示の(1)の処理をするマクロ
　→　設定したシート及び値に対してデータを取得・出力を行います。

「sample2」は、ご提示の(2)の処理をするマクロ
　→　現在表示されているシートに対してご提示の処理を行います。
　　　 出力結果をB1セルに書き出して、該当のセルを選択した状態にします。

▼マクロの設定について

「sample1」はコード内の「設定」と書かれたコードを修正することで、ある程度の設定を変更できます。
必要に応じて変更してください。（出力先シートはあらかじめ作成してください）
【Set mySt(0) = Worksheets("Sheet1")】　←　データシート
【Set mySt(1) = Worksheets("Sheet2")】　←　出力先シート
　→　初期の状態ではデータが記載されているシート「Sheet1」を
　　　　「Sheet2」に書出します。
【tList = Array(23, 0, 1, 2, 3, 4, 5)】
　→　23時～5時までの順番で「00：00台」を集計します。
【outCol = Array(3, 4, 1, 2, 6)】
　→　見つかった行の3,4,1,2,6列の順番でデータを書出します。

■VBAコード

'(1)のコード――――――――――――――――――――――
Sub sample1()
Dim i As Long, j As Integer, k As Integer
Dim tList As Variant, outCol As Variant
Dim cnt As Long, flag As Boolean, mySt(1) As Worksheet
'///////////////設定///////////////
'データのシートを指定
Set mySt(0) = Worksheets("Sheet1")
'出力先のシートを指定
Set mySt(1) = Worksheets("Sheet2")
'出力する時間帯及び順番をカンマ区切りで指定
tList = Array(23, 0, 1, 2, 3, 4, 5)
'出力する列の順番をカンマ区切りで指定
outCol = Array(3, 4, 1, 2, 6)
'//////////////////////////////////
mySt(1).Cells.ClearContents
With mySt(0)
　　For j = 0 To UBound(tList)
　　　　flag = False
　　　　cnt = cnt + 1
　　　　mySt(1).Cells(cnt, "A") = Format(tList(j), "00") & ":00台"
　　　　For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　If Hour(.Cells(i, "C")) = tList(j) Then
　　　　　　　　flag = True
　　　　　　　　cnt = cnt + 1
　　　　　　　　For k = 0 To UBound(outCol)
　　　　　　　　　　mySt(1).Cells(cnt, k + 1) = .Cells(i, outCol(k)).Text
　　　　　　　　Next k
　　　　　　End If
　　　　Next i
　　　　If flag = False Then
　　　　　　Cells(cnt, "A").ClearContents
　　　　　　cnt = cnt - 1
　　　　End If
　　Next j
End With
End Sub

'(2)のコード――――――――――――――――――――――
Sub sample2()
Dim i As Long, j As Long, ans As Integer, myRow As Range
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
　　For j = 3 To Cells(i, Columns.Count).End(xlToLeft).Column - 2
　　　　If Cells(i, j) = Range("A1") Then
　　　　　　If myRow Is Nothing Then
　　　　　　　　Set myRow = Cells(i, j)
　　　　　　Else
　　　　　　　　Set myRow = Union(myRow, Cells(i, j))
　　　　　　End If
　　　　　　ans = ans + Cells(i, Columns.Count).End(xlToLeft)
　　　　　　Exit For
　　　　End If
　　Next j
Next i
If Not myRow Is Nothing Then myRow.Select
Range("B1") = ans
If ans = 0 Then Range("A1").Select
End Sub