エクセル小僧：更新期限切れのセルを選択（改）：崖の上のジョージ：So-netブログ

	ブログをはじめるログイン

エクセル小僧：更新期限切れのセルを選択（改）　[コンピューター] [編集]

定期的に更新が必要なモノの一覧があって、ファイルを開いたときに
期限切れのセルを選択し、期限切れのセルのうち、一番上のセルがアクティブに
なっているようにするマクロを作ってみました。

http://cheese999.blog.so-net.ne.jp/2016-04-21-1
で紹介したマクロを変更し、シート名、日数、セル範囲を引数にしました。

【条件】
・G列に変更した日が入力されている。
・変更日のセル範囲に"変更日"という名前がついている。
・更新は90日ごとに行う。

【マクロ】
☆呼び出し側
Private Sub Workbook_Open()
  ' Workbookを開いたときの処理
  ' 現在の時刻、更新日を表示
  ' 配列を定義
  Dim str1(2) As String
  Dim mySheet(1) As Worksheet
  Dim myRange1 As Range
  ' 現在の時刻の文字列を生成
  str1(0) = Format(Now(), "yyyy/mm/dd(aaa) hh:mm:ss")
  ' "現在："と改行を連結
  ' Tab[Chr(9)]で：の位置を揃える
  str1(1) = "現在" & Chr(9) & "：" & str1(0) & vbCrLf
  ' 更新日(J1セル)を連結
  Set mySheet(0) = ActiveSheet ' アクティブシートを退避
  Set mySheet(1) = Worksheets("current") ' 更新日のあるシート
  mySheet(1).Activate ' currentシートをアクティブ化
  str1(1) = str1(1) & "更新日" & Chr(9) & "：" & Format(Range("J1"), "yyyy/mm/dd(aaa) hh:mm:ss")
  ' メッセージボックスに現在の日時と更新日を表示
  MsgBox str1(1)
  Set myRange1 = Range("変更日") ' 変更日のセル範囲
  Call HenKigen1(mySheet(1), -90, myRange1) '変更から90日経過した最初のセルへ飛ぶ
End Sub

☆呼び出される側
Sub HenKigen1(ByVal sheet1 As Worksheet, ByVal Nod1 As Long, ByVal myRange1 As Range)
  '【機能】変更から『Nod1』日経過した最初のセルへ飛ぶ
  '【引数】
  ' sheet1 : シート名
  ' Nod1 : 日数 (Number of Days)
  ' myRange1 : 検索対象のセル範囲
  '【変数】
  Dim Day1 As Date ' 基準日
  Dim Range1 As Range ' セル範囲
  Dim Range_t As Range ' セル範囲（合計）
  Dim NoC As Long ' 条件に合致したセル数（Number of Cell)
  Dim Nod2 As Long ' Nod1の逆
  '【コード】
  sheet1.Activate ' 対象シートをアクティブ化
  Day1 = Date ' 今日
  Day1 = DateAdd("d", Nod1, Day1) ' 90日前の場合、Nod1は-90
  For Each Range1 In myRange1
    If (Range1.Value <> "") And (Range1.Value < Day1) Then ' 変更日のセルが空白でなく、かつ、『Nod1』日前より前
      If Range_t Is Nothing Then
        Set Range_t = Range1 ' 最初に条件に合致したセル
        NoC = 1 ' 合致したセル数をカウント
      Else
        Set Range_t = Union(Range_t, Range1) ' 2個目以降に条件に合致したセルを結合
        NoC = NoC + 1 ' 合致したセル数をカウントアップ
      End If
    End If
  Next Range1
  If Not (Range_t Is Nothing) Then ' 合致したセルがあったら
    Application.Goto Range_t(1, 1), True ' 変更から『Nod1』日経過したセルの内、最初のセルへ
    ActiveWindow.SmallScroll ToLeft:=6 ' A列が一番左になるようにスクロール
    Range_t.Select ' 変更から『Nod1』日経過したセル範囲を選択
    Nod2 = 0 - Nod1 ' Nod1の符号を反転
    MsgBox ("変更から" & Nod2 & "日以上経過したセルは" & NoC & "個あります。")
  End If
End Sub

【解説】
・For Each文で、myRange1 のセル範囲内のセルの値を調べていきます。
・セル範囲に"変更日"という名前を付けているのは、セル範囲が変更になってもマクロ変更しなくてもすむようにです。
・アクティブシートを退避して、"current"シートをアクティブ化していますが、マクロ実行前のアクティブシートに戻っていないので、退避する必要はない、ですね。。
・変更日のセルが空白の場合は対象としないよう、(Range1.Value <> "") ではじいています。
・Nod1はマイナスの値で与えられることに注意してください。
・条件に合致したセルをRange_tに格納しますが、１セル目と２セル目では格納の仕方が異なります。１セル目かどうか、つまり、Range_tが空っぽかどうかを、Nothingを使って判定しています。
・Range_t配列は、２次元配列らしいので、左上のセルを指すのにRange_t(1, 1)としています。