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

如何在一张纸上多次使用双击事件之前使用

1 个答案: