将两个 vba 代码合并为一个

Question

我是VBA和Excel的新手，我在Excel中创建了一个数据库，这两个代码对于我的项目工作至关重要。 我想同时运行这些VBA代码，你能帮我合并代码并使其工作吗？ 我自己尝试过，但没有任何效果。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Item As String
Dim SearchRange As Range
Dim rFound As Range
'Don't run the macro if:
'Target is not a single cell:
If Target.Cells.Count > 1 Then Exit Sub
'or Target belongs to the A1.CurrentRegion:
If Not Intersect(Target, Range("A1").CurrentRegion) Is Nothing Then Exit Sub
'Avoid the endless loop:
Application.EnableEvents = False
'Looks for matches from the here first:
Set SearchRange = Range("A1:A" & Range("A1").CurrentRegion.Rows.Count)
Item = Target.Value
'Clears the Target:
Target.Value = ""
If Application.WorksheetFunction.CountIf(SearchRange, Item) > 0 Then
'There's a match already:
Set rFound = Columns(1).Find(What:=Item, After:=Cells(1, 1) _
, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'Adds one to the Quantity:
rFound.Offset(0, 2).Value = rFound.Offset(0, 2).Value + 1
Else
'Writes the value for the Barcode-list:
Range("A" & SearchRange.Rows.Count + 1).Value = Item
'Looks for the match from sheet "Inventory" column A
With Sheets("Inventory")
Set rFound = .Columns(1).Find(What:=Item, After:=.Cells(1, 1) _
, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
On Error GoTo 0
If Not rFound Is Nothing Then
'Writes the Product Name and puts 1 to the Quantity column:
Range("B" & SearchRange.Rows.Count + 1).Value = rFound.Offset(0, 1).Value
Range("C" & SearchRange.Rows.Count + 1).Value = 1
End If
End With
End If
'Enable the Events again:
Application.EnableEvents = True

End Sub

第二个：

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 3 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
With Target.Offset(0, 3)
.Value = Now
.NumberFormat = "DD/MM/YYYY"
End With
End Sub

Answer 1

有很多方法可以组合两个代码。也许最好的方法是重写所有内容，但可能是没有必要或没有时间或没有技能。看看这里一些例子 - 如何组合两个 vba 代码？

我能想到的最懒惰的方法就是简单地模仿Worksheet_Change()事件，将目标传递给另一个私人子：

Private Sub Worksheet_Change(ByVal target As Range)
FirstCode target
SecondCode target
End Sub
Private Sub FirstCode(ByVal target As Range)
Debug.Print target.Address & " from FirstCode()"
End Sub
Private Sub SecondCode(ByVal target As Range)
Debug.Print target.Address & " from SecondCode()"
End Sub