Excel宏 - 如何合併2個不同功能的宏

Question

我是新來的這裏和excel宏初學者。我需要幫助如何在宏下面加入1. - 第一個宏的功能是在輸入特定單元格後將單元格移動到下一行 - 第二個子宏的功能是在上次特定時輸入時間戳行的單元格被輸入。

謝謝... Yanto

的宏：

1日宏（主）

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輸出合併的代碼。再次感謝

的代碼： 顯式的選項

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: