Как использовать перед двойным щелчком по событию несколько раз на одном листе

Question

У меня есть следующие три кода для моего предполагаемого листа X

• первый код

  Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim rFound As Range, vFind
  If Target.Column = 3 Then
  
    Cancel = True
    vFind = Target
      On Error Resume Next
  
      With Sheet4.Columns(3)
          Set rFound = .Find(What:=vFind, After:=.Cells(1, 1), _
          LookIn:=xlValues, LookAt _
          :=xlWhole, SearchOrder:=xlByRows)
      End With
      On Error GoTo 0
  
      If Not rFound Is Nothing Then
          Application.Goto rFound
      Else
           MsgBox "No match for " & vFind & " on " & Sheet4.Name
         End If
  End If
  
  End Sub
  

• второй код

   Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
       Dim rFound As Range, vFind
           If Target.Column = 2 Then
  
        Cancel = True
        vFind = Target
      On Error Resume Next
  
      With Sheet5.Columns(2)
          Set rFound = .Find(What:=vFind, After:=.Cells(1, 1), _
          LookIn:=xlValues, LookAt _
          :=xlWhole, SearchOrder:=xlByRows)
      End With
      On Error GoTo 0
  
      If Not rFound Is Nothing Then
          Application.Goto rFound
      Else
           MsgBox "No match for " & vFind & " on " & Sheet5.Name
          End If
          End If
  
          End Sub
  

• Третий код

  Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim str As String
  Dim cboTemp As OLEObject
  Dim ws As Worksheet
  Set ws = ActiveSheet
  
  Set cboTemp = ws.OLEObjects("ComboBox1")
  On Error Resume Next
  With cboTemp
  'clear and hide the combo box
   .ListFillRange = ""
   .LinkedCell = ""
   .Visible = False
    End With
   On Error GoTo errHandler
    If Target.Validation.Type = 3 Then
    'if the cell contains
      'a data validation list
     Cancel = True
     Application.EnableEvents = False
     'get the data validation formula
     str = Target.Validation.Formula1
     str = Right(str, Len(str) - 1)
     With cboTemp
     'show the combobox with the list
     .Visible = True
     .Left = Target.Left
     .Top = Target.Top
     .Width = Target.Width + 5
     .Height = Target.Height + 5
     .ListFillRange = str
     .LinkedCell = Target.Address
     End With
     cboTemp.Activate
     'open the drop down list automatically
      Me.ComboBox1.DropDown
   End If
  
  errHandler:
    Application.EnableEvents = True
    Exit Sub
  
  End Sub
  

Здесь у меня есть три события для события двойного щелчка на одном листе, но, как мы знаем, одно имя макроса на одном листе неРазрешите, пожалуйста, ребята, помогите мне в этом?Я предполагаю, что слияние макросов - только вариант, но я новичок в vba, так что я, честно говоря, не знаю об этом, поэтому любая помощь будет оценена.Заранее спасибо.

Answer 1

Не похоже, что было бы слишком сложно объединить разрозненные части в оператор Select Case, сохранив аналогичные части.

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

    If Not Intersect(Target, Range("B:C")) Is Nothing Then
        Cancel = True
        Dim rFound As Range, vFind As Variant

        'small bit of error control
        if isempty(target) then exit sub

        vFind = Target.value

        On Error Resume Next
        Select Case Target.Column
            Case 2
                With Sheet5.Columns(2)
                    Set rFound = .Find(What:=vFind, After:=.Cells(1, 1), _
                                       LookIn:=xlValues, LookAt:=xlWhole)
                End With
            Case 3
                With Sheet4.Columns(3)
                    Set rFound = .Find(What:=vFind, After:=.Cells(1, 1), _
                                       LookIn:=xlValues, LookAt:=xlWhole)
                End With                
        End Select
        On Error GoTo 0

        If Not rFound Is Nothing Then
            Application.Goto rFound
        Else
            MsgBox "No match for " & vFind & " on " & _
                   iif(target.column = 3, Sheet4.Name, Sheet5.Name)
        End If
    End If

End Sub