Excelマクロ - マクロの2つの異なる機能をマージする方法

Question

私はここにおり、マクロ初心者を習得しています。私はどのようにマクロの下に1つの方法のための助けが必要です。 - 1番目のマクロの機能は、特定のセルが入力されたら、次の行にセルを移動することです - 最後の特定の行のセルが入力されます。

は... Yanto

マクロをありがとう：

第一マクロ（メイン）

Option Explicit 
Private Sub Worksheet_Change(ByVal Target As Range) 
On Error GoTo Whoa 

Application.EnableEvents = False 

If Not Target.Cells.CountLarge > 1 Then 
If Not Intersect(Target, Columns(1)) Is Nothing Then 
Target.Offset(, 1).Select 
ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then 
Target.Offset(, 1).Select 
ElseIf Not Intersect(Target, Columns(3)) Is Nothing Then 
Target.Offset(, 1).Select 
ElseIf Not Intersect(Target, Columns(4)) Is Nothing Then 
Target.Offset(1, -3).Select 
End If 
End If 
Letscontinue: 
Application.EnableEvents = True 
Exit Sub 
Whoa: 
MsgBox Err.Description 
Resume Letscontinue 
End Sub 

第二マクロ（サブ）

Private Sub Worksheet_Change1(ByVal Target As Range) 

If Intersect(Target, Range("D2:D3000")) Is Nothing Then Exit Sub 
If Target.Count > 1 Then Exit Sub 
If Target = "" Then Exit Sub 
Dim lc As Long 

With Application 
.EnableEvents = False 
.ScreenUpdating = False 
lc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column 
If lc = 1 Then 
Cells(Target.Row, lc + 2) = Now() 
ElseIf lc > 1 Then 
Cells(Target.Row, lc + 1) = Now() 
End If 
.EnableEvents = True 
.ScreenUpdating = True 
End With 

End Sub 

Answer 1

ただ、サブマクロを呼び出しますあなたのメインマクロの名前：

Private Sub Worksheet_Change(ByVal Target As Range) 
'''''''''''''''''some code'''''''''''''''''''' 
    call Worksheet_Change1(Target) 
'''''''''''''''''some code'''''''''''''''''''' 
End Sub 

Answer 2

フレンド、 私のコメントを無視してください。私は、期待通りにexec出力とマージされたコードを得ることができました。おかげで再び

コード： ます。Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range) 

On Error GoTo Whoa 

Application.EnableEvents = False 

If Not Target.Cells.CountLarge > 1 Then 
If Not Intersect(Target, Columns(1)) Is Nothing Then 
Target.Offset(, 1).Select 
ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then 
Target.Offset(, 1).Select 
ElseIf Not Intersect(Target, Columns(3)) Is Nothing Then 
Target.Offset(, 1).Select 
ElseIf Not Intersect(Target, Columns(4)) Is Nothing Then 
Target.Offset(1, -3).Select 
End If 
End If 

Call Worksheet_Change1(Target) 

Letscontinue: 
Application.EnableEvents = True 
Exit Sub 
Whoa: 
MsgBox Err.Description 
Resume Letscontinue 

End Sub 


Private Sub Worksheet_Change1(ByVal Target As Range) 
If Intersect(Target, Range("D2:D3000")) Is Nothing Then Exit Sub 
If Target.Count > 1 Then Exit Sub 
If Target = "" Then Exit Sub 
Dim lc As Long 
With Application 
.EnableEvents = False 
.ScreenUpdating = False 
lc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column 
If lc = 1 Then 
Cells(Target.Row, lc + 2) = Now() 
ElseIf lc > 1 Then 
Cells(Target.Row, lc + 1) = Now() 
End If 
.EnableEvents = True 
.ScreenUpdating = True 
End With 

End Sub 

The Image link: