日付と名前でソートされたエクセルファイルをまとめるマクロについて

Question

上図の様なエクセルファイルがあり、日付と名前と開始時間でソートされています。

右側に5分間隔で刻まれた軸があり、該当する時間帯に1を入力するマクロを作成したいと思っております。

例）1行目であれば、
18：45 18：50 18：55 19：00 19：05 19：10 19：15 19：20 19：25
1 1 1 1 1 1 1 1

といった感じです。
また、同じ日付に関しては1行にまとめたいです。

しかし、開始時間と終了時間で表されたデータから、5分刻みのどこに入れるのかを判別させる方法が思いつきません。

どなたかアイデアがあればご教授お願い致します。

Answer 1

差し出がましいようですが興味が湧いたので作ってみました。
参考になれば幸いです。

Option Explicit
Sub test()
    Dim StartHour As Integer    '開始時刻(時)
    Dim StartMinute As Integer  '開始時刻(分)
    Dim EndHour As Integer      '終了時刻(時)
    Dim EndMinute As Integer    '終了時刻(分)
    
    Dim CurHour As Integer      '現在の列の1行目に記載されている時刻(時)
    Dim CurMinute As Integer    '現在の列の1行目に記載されている時刻(分)
    Dim NextHour As Integer     '次の列の1行目に記載されている時刻(時)
    Dim NextMinute As Integer   '次の列の1行目に記載されている時刻(分)
    
    Dim MaxRows As Integer      '最大行数
    Dim MaxColumns As Integer   '最大列数
    
    Dim CurRow As Integer       '現在の行番号
    Dim CurColumn As Integer    '現在の列番号
       
    MaxRows = Range("A1").CurrentRegion.Rows.Count          '最大行数取得
    MaxColumns = Range("A1").CurrentRegion.Columns.Count    '最大列数取得
        
    For CurRow = 2 To MaxRows   '2行目から最終行まで順番に処理(1行目は見出しだけなので処理しない)
        For CurColumn = 3 To MaxColumns '3列目から最終列まで順番に処理
            If CurColumn = 3 Then
                '現在列が3列目の場合は開始時刻を取得
                StartHour = Hour(Cells(CurRow, CurColumn).Value)
                StartMinute = Minute(Cells(CurRow, CurColumn).Value)
            ElseIf CurColumn = 4 Then
                '現在列が4列目の場合は終了時刻を取得
                EndHour = Hour(Cells(CurRow, CurColumn).Value)
                EndMinute = Minute(Cells(CurRow, CurColumn).Value)
            Else
                '自列1行目に記載されている時刻を取得
                CurHour = Hour(Cells(1, CurColumn).Value)
                CurMinute = Minute(Cells(1, CurColumn).Value)
                
                '次の列の1行目に記載されている時刻を取得
                NextHour = Hour(Cells(1, CurColumn + 1).Value)
                NextMinute = Minute(Cells(1, CurColumn + 1).Value)
                              
                If StartHour < CurHour Or (StartHour = CurHour And StartMinute - CurMinute <= 4) Then
                    '開始「時」が1行目の「時」未満、もしくは
                    '開始「時」が1行目の「時」と同じかつ、開始「分」マイナス1行目の「分」が4分以下の場合
                    '現在セルに"1"を書き込む
                    Cells(CurRow, CurColumn).Value = "1"
                End If

                If EndHour < NextHour Or (EndHour = NextHour And EndMinute < NextMinute) Then
                    '終了「時」が次列の「時」未満の場合、もしくは
                    '終了「時」が次列の「時」と同じかつ、終了「分」が次列の「分」未満の場合
                    '内側のループを抜けて次の行の処理に移る
                    Exit For
                End If
            End If
        Next
    Next
End Sub

Comments

[ynakano]

24時またぎはなし、と言うことで･･･

[ynakano]

いや、ちょっとだけおかしいです。
調べて直します。申し訳ない。

[ynakano]

修正しました。開始時刻のセル書き込み判定が間違ってました。
また判定ルールとしては、例えば"08:00"のセルには08:00～08:04が該当する、という事にしています。

[ynakano]

また修正しました。
今までのだと開始08:00、終了08:04など、1セルだけに書き込むケースが正しく判定できてなかったです。
そこの見直しをしつつロジックをすっきりさせました。
フラグなんかいらなかったんじゃん…

[churi_yuzuki]

出来ました！！
ありがとうございます！！
全部組んでもらって申し訳ありません。。

[ynakano]

面白そうだったので作ってはみたのですが、他の質問やakio221さんは考え方の提示が主のようだったので、全部作ってよかったのかと今になって自問自答してます。
ともあれお役に立つなら何よりですし、コードを「読んで」いただければと思います。
※上から目線っぽくて申し訳ないです。

> akio221さん
お邪魔して申し訳ありませんでした。

[churi_yuzuki]

いえ、丸投げしてしまった自分が悪いのでお気になさらずに、、
あくまで参考にさせて頂く気持ちは忘れておりません。
ありがとうございました！

Answer 2

12時をまたがないデータ群であれば、以下の手抜きロジックでいかがですか
・読み込むデータのあるシートと、結果を作成するシートを分離。
・・縦軸の行番号は、日付を用いた順番とする。（例えば1日なら見出しを除外した2行目開始）
・・横軸の列見出しは時刻の下4桁を数値化したものを用いる

・データの行ごとにループ
・・開始日付の日付から結果を「書き込む行」を求める。
・・開始日付の4桁を数値化する。(例 1848)
・・終了日付の4桁を数値化する。(例 1919)
・・列番号でループ
・・・開始数値 <= 見出し行・ループ列番号のセル数値 かつ
・・・見出し行・ループ列番号のセル数値 <= 終了数値ならば
・・・・「書き込む行数」・ループ列番号のセルに1を書く
・・・・（このとき、既に1が入力されていたら、どうするか？）

空白は消去されちゃうので、・をインデント代わりにしてます。読みにくくて申し訳ないです。

Comments

[churi_yuzuki]

初歩的な質問で申し訳ないのですが、、、時間形式をどうやって数値に変換すればいいのでしょうか。。。

[akio221]

VBAにはDay、Hour、Minuteなどの関数が準備されています。
まずは、それらを検索してみることをお勧めします。

例えば、以下のサイトのような参考になるサイトがあるかと。
http://www.239-programing.com/excel-vba/func/func033.html

元シートから取得するデータによっては、文字列型なり日付型なりからの
変換加工が必要かもです。

[churi_yuzuki]

参考リンクありがとうございます。
リンク先を参考に、
Dim s As String
s = Range("C2").Value
Debug.Print s

とした所、sの値がPR10371と表記されていました。
これはString型としたのがおかしいのでしょうか。。

[akio221]

シートの入力で、セルの書式と、セルの中身がどのようになっているのか、
検討もつかないので、申し訳ないですが、わからないです。
日付型か、文字列型ならVBAの関数はわりと鷹揚なので、そのまま結果が返ってきますが・・。

[WoodenHamlet]

回答する時にMarkUpで書くのが面倒で、でもインデントつけたいときは言語指定なしのソース「```～```」に回答ぶち込むといいですよ

[churi_yuzuki]

>akio221さん
すいません、遅くなりました。
型の問題も解決し、なんとか１を入力することができました。
しかし、条件がおかしいのか、例えば13：13であれば13：10のとこに入りませんでした。
条件は複雑になりそうですかね。。。

＞WoodenHamletさん
ありがとうございます。

[akio221]

もしかしてですが、hour(time)や、minute(time)の結果をそのまま繫いで、
文字列比較したりしていませんか？

読み込み部分は、
Dim sttime as String
sttime = Sheet(1).Cells(row, col).value 'row col は任意の行・列番号

と、読んで、比較したい値は文字列ではなく、Longあたりに変換して、

Dim Tst as Long
Tst = CLng(tirm(hour(sttime)) + trim(minute(sttime)))

この後、終了時刻と、比較したい見出し行も同じように、変換して
それから比較してみてください。

[jawa]

横から失礼します。

＞13：13であれば13：10のとこに入りませんでした。
見出しの値が上限値なのか下限値なのか、という問題のようですね。

akioさん提示のチェック方法では「開始数値 <= 見出し行」で判定することにしていますよね。
つまり13:10の列は13:05～13:10の範囲を指す領域(見出しの値を上限値)として判定しているということです。
今回の場合、「13:13 <= 13:10」ではないため、この判定だと13:10の列には１が入りません。

逆に、13:13の時に13:10の列から１を付け始めたいということは、13:10の列は13:10～13:15を指す領域（見出しの値を下限値）としたいということですね。
であれば、判定は「開始数値 < 見出し行 + 5分」とすれば良いと思います。

[akio221]

判定誤りでした、これは、失礼しました。

[churi_yuzuki]

遅れました、判定条件が違ったみたいです^^;
無事解決しました！
ありがとうございます！