将两个vba代码合并为一个

时间:2019-12-10 19:50:18

标签: excel vba

我也是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

1 个答案:

答案 0 :(得分:3)

有很多方法可以组合两个代码。最好的方法可能是重写所有内容,但是可能没有必要,没有时间或没有技能。看看这里的示例-How to combine two vba codes?

我能想到的最懒惰的方法只是模仿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