質問編集履歴
1
coco_bauerさんの回答コードで標示された内容を載せました。
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -121,3 +121,101 @@
|
|
|
121
121
|
皆様のお力をお借りしたいと思っています。
|
|
122
122
|
|
|
123
123
|
よろしくお願い致します。
|
|
124
|
+
|
|
125
|
+
|
|
126
|
+
|
|
127
|
+
|
|
128
|
+
|
|
129
|
+
|
|
130
|
+
|
|
131
|
+
|
|
132
|
+
|
|
133
|
+
|Ｎ列 |O列 |Ｐ列|
|
|
134
|
+
|
|
135
|
+
|会社メールアドレス|契約名|契約分野|
|
|
136
|
+
|
|
137
|
+
| |色、表示無し|色、表示無し|
|
|
138
|
+
|
|
139
|
+
| |色付き|色無し、13158600
|
|
140
|
+
|
|
141
|
+
| |色無し|色無し、表示無し|
|
|
142
|
+
|
|
143
|
+
| |色付き|色無し、13158600|
|
|
144
|
+
|
|
145
|
+
ここから下は
|
|
146
|
+
|
|
147
|
+
| |色付き|色無し、13158600|の表示になります。
|
|
148
|
+
|
|
149
|
+
|
|
150
|
+
|
|
151
|
+
|
|
152
|
+
|
|
153
|
+
’Sub 契約終了日確認()
|
|
154
|
+
|
|
155
|
+
'契約終了日確認 Macro
|
|
156
|
+
|
|
157
|
+
'行いたい事：今日から契約終了年月日まで60日を切っている契約名を表示させる。
|
|
158
|
+
|
|
159
|
+
'①：msgboxで今日の日付を返す。
|
|
160
|
+
|
|
161
|
+
'②：契約終了日から今日の日付を引く。
|
|
162
|
+
|
|
163
|
+
'③：60日を切っていたらその契約名をmsgboxに載せる。
|
|
164
|
+
|
|
165
|
+
Dim ws As Worksheet
|
|
166
|
+
|
|
167
|
+
Dim fname As String
|
|
168
|
+
|
|
169
|
+
Dim 既存ファイル名 As String
|
|
170
|
+
|
|
171
|
+
Dim 保存ファイル名 As String
|
|
172
|
+
|
|
173
|
+
|
|
174
|
+
|
|
175
|
+
Dim 契約終了日 As Long
|
|
176
|
+
|
|
177
|
+
Dim 終了日まで As Long
|
|
178
|
+
|
|
179
|
+
Dim 確認 As Variant
|
|
180
|
+
|
|
181
|
+
Dim 契約名 As String '契約終了日が60日を切っている契約名を載せる
|
|
182
|
+
|
|
183
|
+
Dim ah As Range
|
|
184
|
+
|
|
185
|
+
Dim aj As Range
|
|
186
|
+
|
|
187
|
+
Dim al As Range
|
|
188
|
+
|
|
189
|
+
Worksheets("シート名").Select
|
|
190
|
+
|
|
191
|
+
Dim enddate As Date
|
|
192
|
+
|
|
193
|
+
Dim i As Integer
|
|
194
|
+
|
|
195
|
+
For i = 6 To 65
|
|
196
|
+
|
|
197
|
+
enddate = DateSerial(Range("AH" & Format(i)), Range("AJ" & Format(i)), Range("AL" & Format(i)))
|
|
198
|
+
|
|
199
|
+
MsgBox enddate 'ここで契約終了日から今日の日付を引いて60日未満の契約名を載せたい。
|
|
200
|
+
|
|
201
|
+
'MsgBox todaydate - Date
|
|
202
|
+
|
|
203
|
+
If (enddate - Date) < 60 Then
|
|
204
|
+
|
|
205
|
+
Range("P" & Format(i)).Value = Range("O" & Format(i)).Interior.Color '元の色を隣(P列)のセルに保存。
|
|
206
|
+
|
|
207
|
+
Range("O" & Format(i)).Interior.Color = RGB(200, 200, 200) 'セルに色を付ける
|
|
208
|
+
|
|
209
|
+
End If
|
|
210
|
+
|
|
211
|
+
Next
|
|
212
|
+
|
|
213
|
+
Dim rowNo As Integer '色を変えるセルの行番号を入れる変数
|
|
214
|
+
|
|
215
|
+
Range("O" & rowNo).Interior.Color = Range("P" & rowNo).Value 'セルに色を付ける
|
|
216
|
+
|
|
217
|
+
End Sub’
|
|
218
|
+
|
|
219
|
+
|
|
220
|
+
|
|
221
|
+
コードも掲載しておきます。
|