教えてください。
マクロ初心者ですが、色々なところから検索してI列に文字が入力されるとJ列に自動で
明日の日付が入るようにまた、入力したIとJのセルを色つけまで完成させました。
次の列以降にも同じ作業を行いたいときのVBAを教えてください。
(「KとL」「MとN」に同じ処理をしたい場合)
ループ処理など見たのですが、行のようでよくわかりませんでした。
ちなみに作成したVBAがこちらです。
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If Application.Intersect(Range("I1:I100"), Target) Is Nothing Then Exit Sub
If .Count > 1 Then Exit Sub
If IsEmpty(.Value) Then
.Offset(, 1).ClearContents
Else
.Offset(, 1).Value = Date+1
End If
End With
Dim myColor As Variant
Dim c As Range
Dim myRng As Range
Set myRng = Application.Intersect(Range("I:I"), Target)
If myRng Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each c In myRng
Select Case c.Value
Case 1
myColor = 36
Case 2
myColor = 38
Case 3
myColor = 40
Case 4
myColor = 39
Case 5
myColor = 34
Case 6
myColor = 35
Case Else
myColor = xlNone
End Select
Cells(c.Row, 9).Resize(1, 2).Interior.ColorIndex = myColor
Next c
Application.EnableEvents = True
End Sub
よろしくお願いします。
下記でお望の事が可能かと思います。
ご確認下さい。
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If Application.Intersect(Range("I1:I100, K1:K100, M1:M100"), Target) Is Nothing Then Exit Sub
If .Count > 1 Then Exit Sub
If IsEmpty(.Value) Then
.Offset(, 1).ClearContents
Else
.Offset(, 1).Value = Date + 1
End If
End With
Dim myColor As Variant
Dim c As Range
Dim myRng As Range
Set myRng = Application.Intersect(Range("I:I, K:K, M:M"), Target)
If myRng Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each c In myRng
Select Case c.Value
Case 1
myColor = 36
Case 2
myColor = 38
Case 3
myColor = 40
Case 4
myColor = 39
Case 5
myColor = 34
Case 6
myColor = 35
Case Else
myColor = xlNone
End Select
Cells(c.Row, c.Column).Resize(1, 2).Interior.ColorIndex = myColor
Next c
Application.EnableEvents = True
End Sub
お礼
ありがとうございます。 やりたい事が実行できました。 これからも頑張って勉強したいと思います。