|
本帖最后由 laoye5403 于 2024-12-19 16:34 编辑
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- With Target
- If .Column <> 2 Or .Row < 4 Then b = True '如果用户选择的单元格不是第2列或者小于4行
- If .Columns.Count > 1 Or .Rows.Count > 1 Then b = True '如果用户选择的单元格数量大于1
- End With
- If b Then
- ListBox1.Visible = False '不可见
- TextBox1.Visible = False '不可见
- Exit Sub '退出程序
- End If
- With Sheet2
- endrow = .Cells(.Rows.Count, 1).End(xlUp).Row
- arr = .Range("a2:a" & endrow)
- End With
- With TextBox1
- .Value = ""
- .Visible = True '可见
- .Top = Target.Top '文本框顶部位置
- .Left = Target.Left '文本框左侧位置
- .Height = Target.Height '文本框高度
- .Width = Target.Width '文本框宽度
- .Activate '激活文本框
- End With
- With ListBox1
- .ColumnCount = 1 '列表中列数
- .Visible = True '可见
- .Top = Target.Offset(0, 1).Top '上下位置
- .Left = Target.Offset(0, 1).Left '左右位置
- .Height = 150 '高度
- .ColumnWidths = "100" '每列的宽度
- .Font.Size = 11 '列表中字体大小
- .List = arr
- End With
- End Sub
- '根据文本框的输入值动态匹配数据
- Private Sub TextBox1_Change()
- With Sheet2
- endrow = .Cells(.Rows.Count, 1).End(xlUp).Row
- arr = .Range("a2:a" & endrow)
- End With
- If TextBox1.Text = "" Then ListBox1.List = arr: Exit Sub
- ReDim brr(1 To endrow)
- For i = LBound(arr) To UBound(arr)
- k = 0
- For j = 1 To Len(TextBox1.Text)
- If InStr(1, arr(i, 1), Mid(TextBox1.Text, j, 1)) > 0 Then
- k = k + 1
- End If
- Next j
- If k = Len(TextBox1.Text) Then
- m = m + 1
- brr(m) = arr(i, 1)
- End If
- Next i
- ListBox1.List = brr '写入匹配后的数据
- End Sub
- '如果双击列表框的内容则写入活动单元格
- Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
- If ListBox1.ListIndex > -1 Then
- ActiveCell = ListBox1.Text
- With ListBox1
- .Clear '清空列表框
- .Visible = False
- End With
- TextBox1.Visible = False
- End If
- End Sub
复制代码 我这个半桶水也可以帮助别人了。
这个应该是达到你的要求了,动态查找,比如“我是中国共产党员8”,输入“8员”、“我员中”等,随便乱输入都可以查找。
|
|