Excel 数据验证列表中的自动完成建议再次出现
Autocomplete suggestion in Excel data validation list again
如何在输入时在 Excel 数据验证列表中提出建议。我的要求有限制:
- 项目列表应该在另一个 sheet 中,并且不能在上面的隐藏行中。
- 键入一个词组应将列表缩小到包含该词组的所有项目。
- 搜索应该不区分大小写。
因此,在输入 am
后,我们应该假设有一个建议可以从 Amelia
、Camila
、Samantha
中挑选,前提是这些女孩的名字在项目列表。
我找到了一个很好的解决方案 here,但是它不会过滤带有 contains
子句但 begins with
的项目。我在这里总结一下建议的解决方案。
- 我们将组合框(ActiveX 控件)插入 sheet。
我们右键点击一个sheet名字>查看代码>然后在sheetVBA编辑器中粘贴VBA代码:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2018/9/21
Dim xCombox As OLEObject
Dim xStr As String
Dim xWs As Worksheet
Dim xArr
Set xWs = Application.ActiveSheet
On Error Resume Next
Set xCombox = xWs.OLEObjects("TempCombo")
With xCombox
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
If Target.Validation.Type = 3 Then
Target.Validation.InCellDropdown = False
Cancel = True
xStr = Target.Validation.Formula1
xStr = Right(xStr, Len(xStr) - 1)
If xStr = "" Then Exit Sub
With xCombox
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = xStr
If .ListFillRange = "" Then
xArr = Split(xStr, ",")
Me.TempCombo.List = xArr
End If
.LinkedCell = Target.Address
End With
xCombox.Activate
Me.TempCombo.DropDown
End If
End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 9
Application.ActiveCell.Offset(0, 1).Activate
Case 13
Application.ActiveCell.Offset(1, 0).Activate
End Select
End Sub
我找不到将搜索选项从 'begins with' 更改为 contains
的修改方法。
到目前为止,关于验证列表中的自动完成或自动建议的问题已被问到。
Excel data validation with suggestions/autocomplete
Excel 2010: how to use autocomplete in validation list
但是它们都没有包含满足我施加的限制的答案。
下载的测试文件是here。
尝试添加以下事件(另外还有另外两个)。每次您输入内容时,代码都会刷新 ComboBox 列表。
Private Sub TempCombo_Change()
With Me.TempCombo
If Not .Visible Then Exit Sub
.Clear 'needs property MatchEntry set to 2 - fmMatchEntryNone
.Visible = False 'to refresh the drop down
.Visible = True
.Activate
Dim xStr As String, xArr As Variant
xStr = TempCombo.TopLeftCell.Validation.Formula1
xStr = Right(xStr, Len(xStr) - 1)
xArr = Split(xStr, Application.International(xlListSeparator))
Dim itm As Variant
For Each itm In xArr
If InStr(1, itm, .Value, vbTextCompare) > 0 Or .Value = "" Then
.AddItem itm
End If
Next itm
.DropDown
End With
End Sub
为了克服你的第一个约束,也许你可以为你的组合框指定一个范围:
Dim xCombox As OLEObject
Dim xStr As String
Dim xWs As Worksheet
Dim xArr
Dim i As Range
Set xWs = Application.ActiveSheet
On Error Resume Next
Set xCombox = xWs.OLEObjects("Combotest")
With Sheets("Test_list2")
Set i = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
Combotest.ListFillRange = i.Address
Set xWs = Application.ActiveSheet
On Error Resume Next
Set xCombox = xWs.OLEObjects("Combotest")
With xCombox
.LinkedCell = "F2"
.Visible = True
End With
.
.
.
.
End Sub
如何在输入时在 Excel 数据验证列表中提出建议。我的要求有限制:
- 项目列表应该在另一个 sheet 中,并且不能在上面的隐藏行中。
- 键入一个词组应将列表缩小到包含该词组的所有项目。
- 搜索应该不区分大小写。
因此,在输入 am
后,我们应该假设有一个建议可以从 Amelia
、Camila
、Samantha
中挑选,前提是这些女孩的名字在项目列表。
我找到了一个很好的解决方案 here,但是它不会过滤带有 contains
子句但 begins with
的项目。我在这里总结一下建议的解决方案。
- 我们将组合框(ActiveX 控件)插入 sheet。
我们右键点击一个sheet名字>查看代码>然后在sheetVBA编辑器中粘贴VBA代码:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Update by Extendoffice: 2018/9/21 Dim xCombox As OLEObject Dim xStr As String Dim xWs As Worksheet Dim xArr Set xWs = Application.ActiveSheet On Error Resume Next Set xCombox = xWs.OLEObjects("TempCombo") With xCombox .ListFillRange = "" .LinkedCell = "" .Visible = False End With If Target.Validation.Type = 3 Then Target.Validation.InCellDropdown = False Cancel = True xStr = Target.Validation.Formula1 xStr = Right(xStr, Len(xStr) - 1) If xStr = "" Then Exit Sub With xCombox .Visible = True .Left = Target.Left .Top = Target.Top .Width = Target.Width + 5 .Height = Target.Height + 5 .ListFillRange = xStr If .ListFillRange = "" Then xArr = Split(xStr, ",") Me.TempCombo.List = xArr End If .LinkedCell = Target.Address End With xCombox.Activate Me.TempCombo.DropDown End If End Sub Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Select Case KeyCode Case 9 Application.ActiveCell.Offset(0, 1).Activate Case 13 Application.ActiveCell.Offset(1, 0).Activate End Select End Sub
我找不到将搜索选项从 'begins with' 更改为 contains
的修改方法。
到目前为止,关于验证列表中的自动完成或自动建议的问题已被问到。
Excel data validation with suggestions/autocomplete
Excel 2010: how to use autocomplete in validation list
但是它们都没有包含满足我施加的限制的答案。
下载的测试文件是here。
尝试添加以下事件(另外还有另外两个)。每次您输入内容时,代码都会刷新 ComboBox 列表。
Private Sub TempCombo_Change()
With Me.TempCombo
If Not .Visible Then Exit Sub
.Clear 'needs property MatchEntry set to 2 - fmMatchEntryNone
.Visible = False 'to refresh the drop down
.Visible = True
.Activate
Dim xStr As String, xArr As Variant
xStr = TempCombo.TopLeftCell.Validation.Formula1
xStr = Right(xStr, Len(xStr) - 1)
xArr = Split(xStr, Application.International(xlListSeparator))
Dim itm As Variant
For Each itm In xArr
If InStr(1, itm, .Value, vbTextCompare) > 0 Or .Value = "" Then
.AddItem itm
End If
Next itm
.DropDown
End With
End Sub
为了克服你的第一个约束,也许你可以为你的组合框指定一个范围:
Dim xCombox As OLEObject
Dim xStr As String
Dim xWs As Worksheet
Dim xArr
Dim i As Range
Set xWs = Application.ActiveSheet
On Error Resume Next
Set xCombox = xWs.OLEObjects("Combotest")
With Sheets("Test_list2")
Set i = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
Combotest.ListFillRange = i.Address
Set xWs = Application.ActiveSheet
On Error Resume Next
Set xCombox = xWs.OLEObjects("Combotest")
With xCombox
.LinkedCell = "F2"
.Visible = True
End With
.
.
.
.
End Sub