|
▼ミコ さん:こんばんわ、ちんといいます。
1週間ないの文を赤色にしたいですが。
とりあえず簡易的に作成しました。
文字列の位置から日付けを探し、判定する処理です。
1."<"を見つける。
2.1.でみつけた位置の後ろが必ず日付けになっているとして、日付けの判定
3.一週間以内の文のとき、赤色にする。です。
Sub test()
Dim Start_Moji As Long
Dim End_Moji As Long
For i1 = 2 To Cells(2, 2).End(xlDown).Row
Cells(i1, 2).Select
Selection.Font.ColorIndex = 0
For i2 = 1 To Len(Cells(i1, 2).Value)
If Mid(Cells(i1, 2).Value, i2, 1) = "<" Then
If IsDate(Mid(Cells(i1, 2).Value, i2 + 1, 10)) Then
If Format(Mid(Cells(i1, 2).Value, i2 + 1, 10), "yyyy/mm/dd") >= Format(DateAdd("d", Date, -7), "yyyy/mm/dd") Then
Start_Moji = i2
For i3 = i2 + 1 To Len(Cells(i1, 2).Value)
If Mid(Cells(i1, 2).Value, i3, 1) = "<" Then
End_Moji = i3 - 1
Exit For
End If
Next i3
If i3 > Len(Cells(i1, 2).Value) Then
End_Moji = i3 - 1
End If
'*** 赤色にセット
With ActiveCell.Characters(Start:=Start_Moji, Length:=End_Moji - Start_Moji + 1).Font
.ColorIndex = 3
End With
i2 = i3 - 1
End If
End If
End If
Next i2
Next i1
End Sub
とりあえず、参考までに・・・
|
|