Question

这是一个新问题：

我有两张纸。表1是存在输入数据的表单的地方。当您双击A列中的任何单元格时，会弹出一个用户表单。您可以从工作表2的A列中的任何条目输入几个键，它会自动完成。

我遇到的问题是：我只想在特定的单元格上输入数据，例如A1 ..而不是A的整个列。我想要的第二件事是，而不是双击，我希望它只需单击即可完成工作。任何人都可以帮忙。

以下是Sheet 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

Excel：在VBA中选择单个单元格与整个列

1 个答案: