如何在VBA中将两个私有Worksheet_Change子项合并为一个？

Question

我目前有此代码：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lastrow As Long
    Dim rngList As Range

    lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    Set rngList = Range("AB3").CurrentRegion

    If Target.Cells.Count > 1 Then Exit Sub

    On Error Resume Next

    If Not Intersect(Target, Range("B18:B19")) Is Nothing Then  ' user is in column-A
        Target.Value = Application.WorksheetFunction.VLookup(Target.Value, rngList, 2, False)
    End If

    Set rngList = Nothing
End Sub

和

Private Sub Worksheet_Change(ByVal Target As Range)

Dim lastrow As Long
Dim rngList As Range

lastrow = Cells(Rows.Count, "A").End(xlUp).Row

Set rngList = Range("AC3").CurrentRegion

If Target.Cells.Count > 1 Then Exit Sub

On Error Resume Next

If Not Intersect(Target, Range("B10:B11")) Is Nothing Then  ' user is in column-A
    Target.Value = Application.WorksheetFunction.VLookup(Target.Value, rngList, 2, False)
End If

Set rngList = Nothing

结束子

我想将它们结合在一起使用，但是我不知道如何避免冲突，请多多帮助，谢谢。

Answer 1

如果我对您的理解正确，这应该可以助您一臂之力：

Private Sub Worksheet_Change(ByVal Target As Range)

    WorksheetChanged Target, Range("AC3").CurrentRegion, Range("B10:B11")
    WorksheetChanged Target, Range("AB3").CurrentRegion, Range("B18:B19")

End Sub

Private Sub WorksheetChanged( ByVal Target As Range, ByVal rngList As Range, ByVal intersectRng As Range )

    Dim lastrow As Long

    lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    If Target.Cells.Count > 1 Then Exit Sub

    On Error Resume Next

    If Not Intersect(Target, intersectRng) Is Nothing Then  ' user is in column-A
        Target.Value = Application.WorksheetFunction.VLookup(Target.Value, rngList, 2, False)
    End If

    Set rngList = Nothing
End Sub

在这里，您有一个私有函数，该函数获取Ranges作为参数。 您可以根据需要多次调用此函数（尽管如果在Worksheed_Change Sub中调用过多，Excel可能会变慢）。