こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

2つのVBAを組み合わせる方法

お世話になります、2つのVBAを組み合わせる方法で迷っています。

1つ目が

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, k As Long, myNum As Long
If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
With Target
If .Column = 3 Then
myNum = WorksheetFunction.Max(Range("B9:B39"))
If IsDate(.Value) Then
For i = 9 To 39
If Cells(i, "A").Value = "" Then
Cells(i, "B").Value = ""
Else
Cells(i, "B") = myNum + i - 8
End If
Next i
End If
Else
i = .Row
If .Value = "" Then
Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents
Else
For k = i + 1 To 39
If Cells(k, "A").Value = "" Then
Cells(k, "B").Value = ""
Else
Cells(k, "B") = Cells(k - 1, "B") + 1
End If
Next k
End If
End If
End With
Application.EnableEvents = True
End Sub
です。

2つめが

Private Sub Worksheet_Change(ByVal Target As Range) 

Application.EnableEvents = True

If Intersect(Target, Range("R8:R38")) Is Nothing Then Exit Sub

Application.EnableEvents = False

Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value

Application.EnableEvents = True

End Sub

です。2つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか?

投稿日時 - 2013-12-04 13:57:43

QNo.8372880

すぐに回答ほしいです

質問者が選んだベストアンサー

>If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub

条件に合わない場合、Exit Subで抜けるのではなく、条件に合う場合、実行するという風に直せば考え方として簡単です。

例:Not Intersect(Target, Range("C1,B9:B39")) Is Nothing



Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, k As Long, myNum As Long
If Not Intersect(Target, Range("C1,B9:B39")) Is Nothing And Target.Count = 1 Then
Application.EnableEvents = False
With Target
If .Column = 3 Then
myNum = WorksheetFunction.Max(Range("B9:B39"))
If IsDate(.Value) Then
For i = 9 To 39
If Cells(i, "A").Value = "" Then
Cells(i, "B").Value = ""
Else
Cells(i, "B") = myNum + i - 8
End If
Next i
End If
Else
i = .Row
If .Value = "" Then
Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents
Else
For k = i + 1 To 39
If Cells(k, "A").Value = "" Then
Cells(k, "B").Value = ""
Else
Cells(k, "B") = Cells(k - 1, "B") + 1
End If
Next k
End If
End If
End With
Application.EnableEvents = True
ElseIf Not Intersect(Target, Range("R8:R38")) Is Nothing Then
Application.EnableEvents = False
Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value
Application.EnableEvents = True
End If
End Sub

投稿日時 - 2013-12-04 15:18:17

お礼

凄いです、確かに2つのVBAが作動する様になりました。
この度はありがとうございました、非常に助かります。

投稿日時 - 2013-12-05 02:12:07

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問