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: