今日のデータを入力するセルへ(2) [コンピューター]
9/24の記事で、Date関数とFind関数を使って、エクセルのデータシートの今日のデータを入力する行へ飛ぶマクロを紹介しました。しかし、Find関数を使った検索には、次の制限事項があるため、使いづらいものでした。
http://cheese999.blog.so-net.ne.jp/2014-09-24
１．検索範囲のセルが非表示になっていると検索できない
9/24の記事では、検索前に検索範囲のA列を再表示して、検索していました。
Find関数(メソッド)が、非表示セルでは使用できないことについては、Office TANAKAの「非表示のセルを検索する」の記事を参考にして下さい。
http://officetanaka.net/excel/vba/tips/tips128.htm
２．年月日の表示形式を合わせる必要がある
9/24の記事では、B列が年月日の「日」のみ表示していたため、「年月日」での検索ができず、「年月日」を表示するためにA列を追加していました。
そこで、B列の日付と今日の日付をYear, Month, Day関数を用いて年、月、日に分解して３つとも一致したら、今日の日付が見つかったと判断するようにマクロを書き換えました。
B列の日付のセル(B2:B32)に「日付」という名前を付け、For Each文で繰り返します。以下に変更後のマクロを示します。
01:Sub JumpToday()
02: ' 機能：今日の日付へ飛ぶ
03: ' 【変数】
04: Dim r1 As Range ' 繰り返し用
05: Dim yy1(2) As Integer ' 年
06: Dim mm1(2) As Integer ' 月
07: Dim dd1(2) As Integer ' 日
08: Dim Flag1 As Integer ' フラグ
08: ' 【実行コード】
09: Application.ScreenUpdating = False ' 画面更新停止
10: ' 今日の年、月、日
11: yy1(0) = Year(Date) ' 今日の年
12: mm1(0) = Month(Date) ' 今日の月
13: dd1(0) = Day(Date) ' 今日の日
14: ' 今日の日付を探す
15: Flag1 = 0 ' 今日の日付は見つかっていない
16: For Each r1 In Range("日付")
17: ' 検索対象セルの年、月、日
18: yy1(1) = Year(r1.Value) ' 検索対象セルの年
19: mm1(1) = Month(r1.Value) ' 検索対象セルの月
20: dd1(1) = Day(r1.Value) ' 検索対象セルの日
21: ' 今日の年、月、日と一致した？
22: If (yy1(0) = yy1(1)) And (mm1(0) = mm1(1)) And (dd1(0) = dd1(1)) Then
23: Flag1 = 1 ' 今日の日付が見つかった
24: Exit For ' For文を抜ける
25: End If
26: Next r1
27: If (Flag1 = 0) Then
28: ' 今日の日付無し
29: MsgBox "今日(" & Date & ")の日付が見つかりません。"
30: Else
31: ' 今日の日付有り
32: Application.Goto r1, True ' 見つけたセルを選択してスクロール
33: r1.Offset(0, 2).Select ' 2列右の出社時刻のセルを選択
34: ActiveWindow.SmallScroll Up:=1, ToLeft:=0 ' 1行上にスクロール
35: End If
36: Application.ScreenUpdating = True ' 画面更新再開
36:End Sub
http://cheese999.blog.so-net.ne.jp/2014-09-24
１．検索範囲のセルが非表示になっていると検索できない
9/24の記事では、検索前に検索範囲のA列を再表示して、検索していました。
Find関数(メソッド)が、非表示セルでは使用できないことについては、Office TANAKAの「非表示のセルを検索する」の記事を参考にして下さい。
http://officetanaka.net/excel/vba/tips/tips128.htm
２．年月日の表示形式を合わせる必要がある
9/24の記事では、B列が年月日の「日」のみ表示していたため、「年月日」での検索ができず、「年月日」を表示するためにA列を追加していました。
そこで、B列の日付と今日の日付をYear, Month, Day関数を用いて年、月、日に分解して３つとも一致したら、今日の日付が見つかったと判断するようにマクロを書き換えました。
B列の日付のセル(B2:B32)に「日付」という名前を付け、For Each文で繰り返します。以下に変更後のマクロを示します。
01:Sub JumpToday()
02: ' 機能：今日の日付へ飛ぶ
03: ' 【変数】
04: Dim r1 As Range ' 繰り返し用
05: Dim yy1(2) As Integer ' 年
06: Dim mm1(2) As Integer ' 月
07: Dim dd1(2) As Integer ' 日
08: Dim Flag1 As Integer ' フラグ
08: ' 【実行コード】
09: Application.ScreenUpdating = False ' 画面更新停止
10: ' 今日の年、月、日
11: yy1(0) = Year(Date) ' 今日の年
12: mm1(0) = Month(Date) ' 今日の月
13: dd1(0) = Day(Date) ' 今日の日
14: ' 今日の日付を探す
15: Flag1 = 0 ' 今日の日付は見つかっていない
16: For Each r1 In Range("日付")
17: ' 検索対象セルの年、月、日
18: yy1(1) = Year(r1.Value) ' 検索対象セルの年
19: mm1(1) = Month(r1.Value) ' 検索対象セルの月
20: dd1(1) = Day(r1.Value) ' 検索対象セルの日
21: ' 今日の年、月、日と一致した？
22: If (yy1(0) = yy1(1)) And (mm1(0) = mm1(1)) And (dd1(0) = dd1(1)) Then
23: Flag1 = 1 ' 今日の日付が見つかった
24: Exit For ' For文を抜ける
25: End If
26: Next r1
27: If (Flag1 = 0) Then
28: ' 今日の日付無し
29: MsgBox "今日(" & Date & ")の日付が見つかりません。"
30: Else
31: ' 今日の日付有り
32: Application.Goto r1, True ' 見つけたセルを選択してスクロール
33: r1.Offset(0, 2).Select ' 2列右の出社時刻のセルを選択
34: ActiveWindow.SmallScroll Up:=1, ToLeft:=0 ' 1行上にスクロール
35: End If
36: Application.ScreenUpdating = True ' 画面更新再開
36:End Sub
わざわざご訪問下さってコメントまで頂戴しました。 ありがとう感謝します。 これからも宜しくお願い致します。
http://create2014.blog.so-net.ne.jp/DengueFever#comm201409252218
by Ujiki.oO (2014-09-27 08:50)
Ujiki.oOさん、
どういたしまして。こちらこそ、よろしくお願いします。
「ヤバイぜ！」 ありがとうございます。[__猫]
by cheese999 (2014-09-28 06:32)