SSブログ

エクセルおやぢ:繰り返し [コンピューター]

今回は、エクセル大事典に載っていた、Cells(Rows.Count, 1).End(xlUp).Rowを使ってデータの最終行まで繰り返すマクロの紹介をします。

【やりたいこと】
C列の更新日から、今日までの日数がH3セルの限界日数を超過していたら、その更新日を赤くする。

マクロを使用しなくても、『条件付き書式』を使えば、同じことはできますが、あえてマクロでやってみます。

001.jpg

【マクロの起動】
マクロの起動は、判定ボタンを押して、引数の無いmainマクロを呼び出します。

002.jpg

【mainマクロ】
1: Sub main()
2:  Call USLtDate1("C2", "H3")
3: End Sub

mainマクロから、USLtDate1マクロに2つの引数をつけて呼び出します。
このようにmainマクロを間にかませることで、『マクロの登録』ウィンドウで引数を付けてマクロを呼び出さなくて済むようにしています。

USLtDate1マクロの2つの引数は、
 第一引数:更新日が入力されている先頭セル
 第二引数:限界日数が入力されているセル
を文字列(String)で設定します。

【USLtDate1マクロ】
更新日を1つずつ調べていき、限界日数を超過している更新日のセルを赤く塗ります。

01: Sub USLtDate1(Cell1, Cell2 As String)
02:   ' 経過日数が限界を超えているセルを赤く塗る
03:   ' Cell1 : 更新日の最初のセル
04:   ' Cell2 : 限界日数が入力されているセル
05:   ' Limit1 : 限界日数
06:   Dim MyStr As String
07:   Dim i As Long
08:   Dim Row1(2) As Long ' 行番号
09:   Row1(0) = Range(Cell1).Row ' 更新日の先頭行
10:   Row1(1) = Cells(Rows.Count, Range(Cell1).column).End(xlUp).Row ' 更新日の最終行
11:   ' 更新日の先頭行から、最終行まで繰り返す
12:   For i = Row1(0) To Row1(1)
13:     ' 更新日の経過日数が限界(Cell2)を超えていたら赤くする
14:     MyStr = Range(Cell1).column & i ' 更新日のセルのアドレス
15:     If UFDfDate1(Now(), Cells(i, Range(Cell1).column), Range(Cell2)) Then
16:       Cells(i, Range(Cell1).column).Interior.ColorIndex = 3 '赤
17:     Else
18:       Cells(i, Range(Cell1).column).Interior.ColorIndex = xlNone '無色
19:     End If
20:   Next i
21: End Sub

10行目で更新日の最終行の行番号を計算しています。
Rows.Countは、エクセルの全行数を返します。
Range(Cell1).columnは、更新日の列番号を返します。
Cells(Rows.Count, Range(Cell1).column)で、更新日の列の最終行のセルを返します。
.End(xlUp).Row は上に見ていって更新日が見つかった最初のセルの行数を返せという意味になります。

12行目から、20行目で、更新日を1つずつ調べていきます。
15行目でUFDfDate1関数を呼び出し、限界日数を超過しているか調べます。
超過している場合は、16行目で、セルを赤く塗ります。
超過していない場合は、18行目で、セルを無色にします。

【UFDfDate1マクロ】
2つの日付(Date1, Date2)の差が、限界(Limit1)を超えているか調べ、True or Falseを返します。

01: Function UFDfDate1(Date1, Date2 As Double, Limit1 As Long) As Boolean
02:   ' 経過日数が限界を超えているか否かを返す
03:   ' Date1, Date2 : 日付のシリアル値
04:   ' Limit1 : 限界日数
05:   If (Date1 - Date2) > Limit1 Then
06:     UFDfDate1 = True ' 限界を超えている
07:   Else
08:     UFDfDate1 = False ' 限界を超えていない
09:   End If
10: End Function
タグ:VBA エクセル
ヤバイぜ!(5)  コメント(1)  トラックバック(0) 
共通テーマ:日記・雑感

ヤバイぜ! 5

コメント 1

cheese999

nice! ありがとうございます。
(^_0)ノ
by cheese999 (2012-06-24 22:00) 

Facebook コメント

トラックバック 0

トラックバックの受付は締め切りました

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。