时间戳

首页 > 解决方案 > 在一个工作表中合并两个或多个私有子

excel - 在一个工作表中合并两个或多个私有子

问题描述

我想在一张纸上有两个私有子如下（可能更多）。每个都单独工作，但是当我同时拥有两个时，只有第一个工作。你能帮帮我吗？


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, Me.Range("f6:G19, j6:m19, f22:G35, j22:j35, L22:M35")) Is Nothing Then Exit Sub

    If Not Target.MergeCells Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Else
        If IsEmpty(Target.Cells(1, 1)) Then Exit Sub
    End If

    Cancel = True
    Dim Lastrow As Long
    Lastrow = Sheets("ShoppingCart").Cells(Rows.Count, "C").End(xlUp).Row + 1

    Target.Cells(1, 1).Copy Sheets("ShoppingCart").Cells(Lastrow, 3)



End Sub

和


Private Sub Worksheet_BeforeDoubleClick_B(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, Me.Range("h24:h25, h8:h9")) Is Nothing Then Exit Sub

    If Not Target.MergeCells Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Else
        If IsEmpty(Target.Cells(1, 1)) Then Exit Sub
    End If


    Cancel = True
    Dim Lastrow As Long
    Lastrow = Sheets("ShoppingCart").Cells(Rows.Count, "C").End(xlUp).Row + 1

    Target.Cells(1, 1).Copy Sheets("ShoppingCart").Cells(Lastrow, 3)
    Sheets("ShoppingCart").Cells(Lastrow + 1, 3).Value = "148H3124"


End Sub

非常感谢你。

标签： excelvba

解决方案

事件处理程序具有特定名称，它不会将第二个 sub 识别为事件处理程序，它只是认为一个 sub 恰好具有与第一个相似的名称。您可以重命名两者，然后创建一个新的事件子并从中调用它们，或者将它们组合成一个子。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    dblclick_a target, cancel
    dblclick_b target, cancel
end sub

Private Sub dblclick_a(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, Me.Range("f6:G19, j6:m19, f22:G35, j22:j35, L22:M35")) Is Nothing Then Exit Sub

    If Not Target.MergeCells Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Else
        If IsEmpty(Target.Cells(1, 1)) Then Exit Sub
    End If

    Cancel = True
    Dim Lastrow As Long
    Lastrow = Sheets("ShoppingCart").Cells(Rows.Count, "C").End(xlUp).Row + 1

    Target.Cells(1, 1).Copy Sheets("ShoppingCart").Cells(Lastrow, 3)

End Sub

Private Sub dblclick_b(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, Me.Range("h24:h25, h8:h9")) Is Nothing Then Exit Sub

    If Not Target.MergeCells Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Else
        If IsEmpty(Target.Cells(1, 1)) Then Exit Sub
    End If


    Cancel = True
    Dim Lastrow As Long
    Lastrow = Sheets("ShoppingCart").Cells(Rows.Count, "C").End(xlUp).Row + 1

    Target.Cells(1, 1).Copy Sheets("ShoppingCart").Cells(Lastrow, 3)
    Sheets("ShoppingCart").Cells(Lastrow + 1, 3).Value = "148H3124"


End Sub

推荐阅读