Excel：在VBA中選擇單個單元格與整個列

Question

這是一個新問題：

我有兩張表。工作表1是有表格輸入數據的地方。當你雙擊列A中的任何單元格時，彈出一個用戶窗體。您從工作表2的A列中的任何條目輸入幾個鍵，並自動填充。

我遇到的問題是：我只想在特定的單元格上輸入數據，例如A1 ..而不是A的全部列。我想要的第二件事是，不是雙擊，而是想要它只需單擊即可工作。任何人都可以請幫忙。

下面是表1中的VBA代碼在其中輸入數據

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
Dim uiChosen As String 
Dim MyList As Range 
Dim myPrompt As String 

If Target.Column <> 1 Then Exit Sub 

Set MyList = Sheet2.Range("Cariler") 
myPrompt = "Lütfen Bir Cari Seçin" 
uiChosen = UserForm1.ChooseFromList(MyList, myPrompt, Default:=Target.Value, xlFilterStyle:=xlContains) 

If StrPtr(uiChosen) <> 0 Then 
    Target.Value = uiChosen 
    Cancel = True 
End If 
End Sub 

下面是用戶表單代碼：

Option Explicit 

' in userform's code module 

Dim FullList As Variant 
Dim FilterStyle As XlContainsOperator 
Dim DisableMyEvents As Boolean 
Dim AbortOne As Boolean 
Const xlNoFilter As Long = xlNone 

Private Sub butCancel_Click() 
    Unload Me 
End Sub 

Private Sub butOK_Click() 
    Me.Tag = "OK" 
    Me.Hide 
End Sub 

Private Sub ComboBox1_Change() 
    Dim oneItem As Variant 
    Dim FilteredItems() As String 
    Dim NotFlag As Boolean 
    Dim Pointer As Long, i As Long 

    If DisableMyEvents Then Exit Sub 
    If AbortOne Then AbortOne = False: Exit Sub 
    If TypeName(FullList) Like "*()" Then 
     ReDim FilteredItems(1 To UBound(FullList)) 
     DisableMyEvents = True 
     Pointer = 0 
     With Me.ComboBox1 
      Select Case FilterStyle 
       Case xlBeginsWith: .Tag = LCase(.Text) & "*" 
       Case xlContains: .Tag = "*" & LCase(.Text) & "*" 
       Case xlDoesNotContain: .Tag = "*" & LCase(.Text) & "*": NotFlag = True 
       Case xlEndsWith: .Tag = "*" & LCase(.Text) 
       Case xlNoFilter: .Tag = "*" 
      End Select 

      For Each oneItem In FullList 
       If (LCase(oneItem) Like .Tag) Xor NotFlag Then 
        Pointer = Pointer + 1 
        FilteredItems(Pointer) = oneItem 
       End If 
      Next oneItem 

      .List = FilteredItems 
      .DropDown 

     DisableMyEvents = False 
      If Pointer = 1 Then .ListIndex = 0 
     End With 
    End If 
End Sub 

Private Sub ComboBox1_Click() 
    butOK.SetFocus 
End Sub 

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 
    Select Case KeyCode 
     Case vbKeyReturn: Call butOK_Click 
     Case vbKeyUp, vbKeyDown: AbortOne = True 
    End Select 
End Sub 

Private Sub Label1_Click() 

End Sub 

Private Sub UserForm_Activate() 
    ComboBox1.SetFocus 
    If ComboBox1.Text <> vbNullString Then 
     Call ComboBox1_Change 
    End If 
End Sub 

Private Sub UserForm_Initialize() 
    ComboBox1.MatchEntry = fmMatchEntryNone 
End Sub 

Public Function ChooseFromList(ListSource As Variant, Optional Prompt As String = "Choose one item", _ 
             Optional Title As String = "Cari Arama Programı", Optional Default As String, _ 
             Optional xlFilterStyle As XlContainsOperator = xlBeginsWith) As String 

    Dim Pointer As Long, oneItem As Variant 
    If TypeName(ListSource) = "Range" Then 
     With ListSource 
      Set ListSource = Application.Intersect(.Cells, .Parent.UsedRange) 
     End With 
     If ListSource Is Nothing Then Exit Function 
     If ListSource.Cells.Count = 1 Then 
      ReDim FullList(1 To 1): FullList(1) = ListSource.Value 
     ElseIf ListSource.Rows.Count = 1 Then 
      FullList = Application.Transpose(Application.Transpose(ListSource)) 
     Else 
      FullList = Application.Transpose(ListSource) 
     End If 
    ElseIf TypeName(ListSource) Like "*()" Then 
     ReDim FullList(1 To 1) 
     For Each oneItem In ListSource 
      Pointer = Pointer + 1 
      If UBound(FullList) < Pointer Then ReDim Preserve FullList(1 To 2 * Pointer) 
      FullList(Pointer) = oneItem 
     Next oneItem 
     ReDim Preserve FullList(1 To Pointer) 
    ElseIf Not IsObject(ListSource) Then 
     ReDim FullList(1 To 1) 
     FullList(1) = CStr(ListSource) 
    Else 
     Err.Raise 1004 
    End If 

    Me.Caption = Title 
    Label1.Caption = Prompt 
    FilterStyle = xlFilterStyle 

    DisableMyEvents = True 
    ComboBox1.Text = Default 
    ComboBox1.List = FullList 
    DisableMyEvents = False 

    butOK.SetFocus 
    Me.Show 

    With UserForm1 
     If .Tag = "OK" Then ChooseFromList = .ComboBox1.Text 
    End With 
End Function 

Answer 1

沒有單一的點擊事件。使用Intersect來測試目標細胞是否在給定範圍內。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    If Not Intersect(Target, Range("A1")) Is Nothing Then 
     Dim uiChosen As String 
     Dim MyList As Range 
     Dim myPrompt As String 

     If Target.Column <> 1 Then Exit Sub 

     Set MyList = Sheet2.Range("Cariler") 
     myPrompt = "Lütfen Bir Cari Seçin" 
     uiChosen = UserForm1.ChooseFromList(MyList, myPrompt, Default:=Target.Value, xlFilterStyle:=xlContains) 

     If StrPtr(uiChosen) <> 0 Then 
      Target.Value = uiChosen 
      Cancel = True 
     End If 

    End If 

End Sub