teratail
回答率
85.48%
質問するログイン新規登録
トップに関する質問期日までの日数によって段階的にセルの色を変える機能を実装したい。

編集履歴

質問編集履歴

1

コードの訂正と説明文の訂正

2021/03/04 07:10

投稿

momomo1986
momomo1986

スコア4

test CHANGED
File without changes
test CHANGED
@@ -2,9 +2,11 @@
2
2
 
3
3
  現在作業に使用する機器の校正期日一覧のエクセルにマクロを実装するための作業をしています。
4
4
 
5
+ 今のところ設定した日数の範囲に入ればセルの色が変わるまではできているのですが
6
+
5
7
  校正期日の30日前、20日前、10日間から当日、期日超過と日数が変わるとセルの色が設定した色に変わるという機能を
6
8
 
7
- 実装したいのですが、期日が過ぎているかどうかなら判定できるのですが段階的にセルの色を変えることができません。
9
+ 実装したいのです、。
8
10
 
9
11
 
10
12
 
@@ -24,29 +26,91 @@
24
26
 
25
27
 
26
28
 
27
- 点線内のIfの使い方がじぶんでもおかしいと自分では思ってるのですが、解決策が全く解りません
29
+ ```ExcelVBA
28
30
 
29
- どうぞよろしくお願いいたします。
31
+ Option Explicit
30
32
 
31
33
 
32
34
 
33
- Option Explicit
34
-
35
35
  Sub Alert()
36
36
 
37
- 　　　　　　　　　　　｜
37
+ ' 設定シート
38
38
 
39
- 　　　　　　　　　　　｜
39
+ Dim settingSheet As Worksheet
40
40
 
41
- 　　　　　　　　　　　｜
41
+ Set settingSheet = Worksheets("設定")
42
42
 
43
- 　　　　　　　　　　　｜　　　　省略
43
+
44
44
 
45
- 　　　　　　　　　　　｜
45
+ ' 対象シート
46
46
 
47
- 　　　　　　　　　　　｜
47
+ Dim targetSheet As Worksheet
48
48
 
49
+ Set targetSheet = Worksheets(settingSheet.Cells(1, 2).Value)
50
+
51
+
52
+
49
- 　　　　　　　　　　　｜
53
+ ' 対象列
54
+
55
+ Dim targetColStr As String
56
+
57
+ targetColStr = settingSheet.Cells(2, 2).Value
58
+
59
+
60
+
61
+ ' 対象列の最終行を取得
62
+
63
+ Dim targetColLastRow As Long
64
+
65
+ targetColLastRow = targetSheet.Cells(Rows.Count, targetColStr).End(xlUp).Row
66
+
67
+
68
+
69
+ ' 今日の日付を取得
70
+
71
+ Dim today As Date
72
+
73
+ today = Date
74
+
75
+
76
+
77
+ 'データ開始行を取得
78
+
79
+ Dim dataStartRow As Integer
80
+
81
+ dataStartRow = settingSheet.Cells(3, 2).Value
82
+
83
+
84
+
85
+ ' 対象列を全件チェック
86
+
87
+ Dim i As Integer ' 行数ループカウンタ
88
+
89
+ Dim v As Variant ' セルからの値受け取り変数
90
+
91
+
92
+
93
+ Dim alertCount As Integer ' 期限の過ぎている数
94
+
95
+ alertCount = 0
96
+
97
+
98
+
99
+ Dim checkCount As Integer ' チェック対象の数
100
+
101
+ checkCount = 0
102
+
103
+
104
+
105
+ Dim notDateCount As Integer ' 日付以外の数
106
+
107
+ notDateCount = 0
108
+
109
+
110
+
111
+ Dim targetCell As Range
112
+
113
+ For i = 0 To targetColLastRow - dataStartRow
50
114
 
51
115
 
52
116
 
@@ -54,59 +118,15 @@
54
118
 
55
119
  v = targetCell.Value
56
120
 
57
-
58
121
 
59
- TR = targetCell.Row
60
-
61
- TC = targetCell.Column
62
-
63
-
64
122
 
65
123
  If IsDate(v) Then
66
124
 
67
125
  checkCount = checkCount + 1
68
126
 
69
- TR = targetCell.Row
127
+
70
128
 
71
- TC = targetCell.Column
72
-
73
- ---------------------------------------------------------------------------------------------------------
74
-
75
- **'期日30から21日前でセルを黄色地に黒文字に変更**
76
-
77
- If v + settingSheet.Cells(4, 2).Value <= today Then
129
+ If v + settingSheet.Cells(4, 2).Value <= today Then 'settingSheet.Cellsの値は30で設定
78
-
79
- alertCount = alertCount + 1
80
-
81
- targetCell.Font.Color = RGB(0, 0, 0)
82
-
83
- targetCell.Interior.Color = RGB(255, 204, 0)
84
-
85
- Cells(TR, TC - 11).Font.Color = RGB(0, 0, 0)
86
-
87
- Cells(TR, TC - 11).Interior.Color = RGB(255, 204, 0)
88
-
89
-
90
-
91
- **'期日20～11日前でセルを柿色地に白文字に変更**
92
-
93
- ElseIf v + settingSheet.Cells(5, 2).Value <= today Then
94
-
95
- alertCount = alertCount + 1
96
-
97
- targetCell.Font.Color = RGB(255, 255, 255)
98
-
99
- targetCell.Interior.Color = RGB(255, 153, 0)
100
-
101
- Cells(TR, TC - 11).Font.Color = RGB(255, 255, 255)
102
-
103
- Cells(TR, TC - 11).Interior.Color = RGB(255, 153, 0)
104
-
105
-
106
-
107
- **'期日10日前～当日でセルを赤地に白文字に変更**
108
-
109
- ElseIf v + settingSheet.Cells(6, 2).Value <= today Then
110
130
 
111
131
  alertCount = alertCount + 1
112
132
 
@@ -114,43 +134,15 @@
114
134
 
115
135
  targetCell.Interior.Color = RGB(255, 0, 0)
116
136
 
117
- Cells(TR, TC - 11).Font.Color = RGB(255, 255, 255)
118
-
119
- Cells(TR, TC - 11).Interior.Color = RGB(255, 0, 0)
120
-
121
-
122
-
123
- ** '期日超過でセルを黒地に白文字に変更**
124
-
125
- ElseIf v + settingSheet.Cells(7, 2).Value <= today Then
126
-
127
- alertCount = alertCount + 1
128
-
129
- targetCell.Font.Color = RGB(255, 255, 255)
130
-
131
- targetCell.Interior.Color = RGB(0, 0, 0)
132
-
133
- Cells(TR, TC - 11).Font.Color = RGB(255, 255, 255)
134
-
135
- Cells(TR, TC - 11).Interior.Color = RGB(0, 0, 0)
136
-
137
137
  Else
138
-
139
- ** '当てはまらない物白地に黒文字に変更**
140
138
 
141
139
  targetCell.Font.Color = RGB(0, 0, 0)
142
140
 
143
- targetCell.Interior.Color = RGB(255, 255, 255)
141
+ targetCell.Interior.Color = RGB(255, 255, 255)
144
-
145
- Cells(TR, TC - 11).Font.Color = RGB(0, 0, 0)
146
-
147
- Cells(TR, TC - 11).Interior.Color = RGB(255, 255, 255)
148
142
 
149
143
  End If
150
144
 
151
- -----------------------------------------------------------------------------------------------------------
145
+
152
-
153
-
154
146
 
155
147
  Else
156
148
 
@@ -162,31 +154,21 @@
162
154
 
163
155
  End If
164
156
 
157
+
158
+
165
159
  Next
166
160
 
167
161
 
168
162
 
169
-
170
-
171
- ' 結果シートを更新
163
+
172
-
173
- resultSheet.Cells(3, 19).Value = checkCount
174
-
175
- resultSheet.Cells(4, 19).Value = alertCount
176
-
177
- resultSheet.Cells(5, 19).Value = notDateCount
178
-
179
-
180
-
181
-
182
164
 
183
165
  If alertCount > 0 Then
184
166
 
185
- MsgBox "期限チェック完了しました。期限切れの項目があります。"
167
+ MsgBox "期限チェック完了しました。1か月以内に有効期限の切れるものがあります。"
186
168
 
187
169
  Else
188
170
 
189
- MsgBox "期限チェック完了しました。期限切れの項目はありません。"
171
+ MsgBox "期限チェック完了しました。1か月以内に有効有効期限切れの項目はありません。"
190
172
 
191
173
  End If
192
174
 
@@ -198,6 +180,10 @@
198
180
 
199
181
 
200
182
 
183
+ ```
184
+
185
+
186
+
201
187
 
202
188
 
203
189
  ### 補足情報（FW/ツールのバージョンなど）