excel通过vba实现智能提示功能小结

效果图:

---

 

 

1. 进入开发工具模式

---

因为之前没用过excel开发，找excel如何添加控件浪费了些时间。

 

2.添加2个ActiveX控件：textbox和listbox

---

如图

 

3.进入vba代码模式

---

快捷键Alt+F11

 

4.代码（具体代码不解释了，比较容易理解）

---

考虑到各种快捷键的方便性，大家可以继续添加功能来简易操作

'模块1
Public Function LChin(Str As String) As Variant
    On Error Resume Next
    Str = StrConv(Str, vbNarrow)
    If Asc(Str) > 0 Or Err.Number = 1004 Then LChin = ""
    LChin = WorksheetFunction.VLookup(Str, [{"吖","a";"八","b";"嚓","c";"咑","d";"鵽","e";"发","f";"猤","g";

"铪","h";"夻","j";"咔","k";"垃","l";"嘸","m";"旀","n";"噢","o";"妑","p";"七","q";"囕","r";"仨","s";"他","t";"屲","w";"夕","x";"丫","y";"帀","z"}], 2)
End Function

 

'录入表

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim r1
    ActiveCell.Value = ListBox1.Value
    Me.ListBox1.Clear
    Me.TextBox1 = ""
    Me.ListBox1.Visible = False
    Me.TextBox1.Visible = False
    If col = 2 Then
        Set r1 = Sheet8.Range("a:a").Find(ActiveCell.Value, , , xlWhole)
        ActiveCell.Offset(0, 7) = Sheet8.Cells(r1.Row, 0).Value
    ElseIf col > 2 And col < 6 Then
        Set r1 = Sheet8.Range("c:c").Find(ActiveCell.Value, , , xlWhole)
        ActiveCell.Offset(0, 7) = Sheet8.Cells(r1.Row, 2).Value
    ElseIf col > 5 And col < 8 Then
        Set r1 = Sheet8.Range("e:e").Find(ActiveCell.Value, , , xlWhole)
        ActiveCell.Offset(0, 7) = Sheet8.Cells(r1.Row, 4).Value
    ElseIf col > 7 And col < 18 Then
        Set r1 = Sheet8.Range("g:g").Find(ActiveCell.Value, , , xlWhole)
        ActiveCell.Offset(0, 7) = Sheet8.Cells(r1.Row, 6).Value
    ElseIf col > 17 And col < 21 Then
        Set r1 = Sheet8.Range("i:i").Find(ActiveCell.Value, , , xlWhole)
        ActiveCell.Offset(0, 7) = Sheet8.Cells(r1.Row, 8).Value
    End If
End Sub
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        ActiveCell.Value = ListBox1.Value
        Me.ListBox1.Clear
        Me.TextBox1 = ""
        Me.ListBox1.Visible = False
        Me.TextBox1.Visible = False
    End If
    If KeyCode = vbKeyLeft Then
        Sheet3.TextBox1.Activate
    End If
End Sub
Private Sub ListBox1_GotFocus()
    On Error Resume Next
    ListBox1.ListIndex = 0
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Or KeyCode = vbKeyUp Or KeyCode = vbKeyDown Or KeyCode = vbKeyRight Then
        Sheet3.ListBox1.Activate
    End If
    If KeyCode = vbKeyDelete Then
        ActiveCell.Value = ""
        Me.ListBox1.Clear
        Me.TextBox1 = ""
        Me.ListBox1.Visible = False
        Me.TextBox1.Visible = False
    End If
    If KeyCode = vbKeyEscape Then
        Me.ListBox1.Clear
        Me.TextBox1 = ""
        Me.ListBox1.Visible = False
        Me.TextBox1.Visible = False
    End If
End Sub
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim i As Integer
    Dim Language As Boolean
    Dim myStr As String, strText$, n1&
    Me.ListBox1.Clear
    With Me.TextBox1
        For i = 1 To Len(.Value)
            If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Then
                Language = True
                myStr = myStr & Mid$(.Value, i, 1)
            Else
                myStr = myStr & LCase(Mid$(.Value, i, 1))
            End If
        Next
    End With
    With Sheet8
    If col = 2 Then
        For i = 2 To .Range("A65536").End(xlUp).Row
            If Language = True Then
                n1 = InStr(.Cells(i, 1), myStr)
                If n1 > 0 Then
                    Me.ListBox1.AddItem .Cells(i, 1).Value
                End If
            Else
                n1 = InStr(.Cells(i, 2), myStr)
                If n1 > 0 Then
                    Me.ListBox1.AddItem .Cells(i, 1).Value
                End If
            End If
        Next
    ElseIf col > 2 And col < 6 Then
        For i = 2 To .Range("C65536").End(xlUp).Row
            If Language = True Then
                n1 = InStr(.Cells(i, 3), myStr)
                If n1 > 0 Then
                    Me.ListBox1.AddItem .Cells(i, 3).Value
                End If
            Else
                n1 = InStr(.Cells(i, 4), myStr)
                If n1 > 0 Then
                    Me.ListBox1.AddItem .Cells(i, 3).Value
                End If
            End If
        Next
    ElseIf col > 5 And col < 8 Then
        For i = 2 To .Range("E65536").End(xlUp).Row
            If Language = True Then
                n1 = InStr(.Cells(i, 5), myStr)
                If n1 > 0 Then
                    Me.ListBox1.AddItem .Cells(i, 3).Value
                End If
            Else
                n1 = InStr(.Cells(i, 6), myStr)
                If n1 > 0 Then
                    Me.ListBox1.AddItem .Cells(i, 3).Value
                End If
            End If
        Next
    ElseIf col > 7 And col < 18 Then
        For i = 2 To .Range("G65536").End(xlUp).Row
            If Language = True Then
                n1 = InStr(.Cells(i, 7), myStr)
                If n1 > 0 Then
                    Me.ListBox1.AddItem .Cells(i, 3).Value
                End If
            Else
                n1 = InStr(.Cells(i, 8), myStr)
                If n1 > 0 Then
                    Me.ListBox1.AddItem .Cells(i, 3).Value
                End If
            End If
        Next
    ElseIf col > 17 And col < 21 Then
        For i = 2 To .Range("I65536").End(xlUp).Row
            If Language = True Then
                n1 = InStr(.Cells(i, 9), myStr)
                If n1 > 0 Then
                    Me.ListBox1.AddItem .Cells(i, 3).Value
                End If
            Else
                n1 = InStr(.Cells(i, 10), myStr)
                If n1 > 0 Then
                    Me.ListBox1.AddItem .Cells(i, 3).Value
                End If
            End If
        Next
    End If
    End With

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Integer
    If Target.Count > 1 Then Exit Sub
    If Target.Row < 2 Then Exit Sub
    If Target.Column < 2 Or Target.Column > 22 Then Exit Sub
    Me.ListBox1.Clear
    col = Target.Column
            With Me.TextBox1
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left
                .Width = Target.Width
                .Height = Target.Height
                .Activate
            End With
            With Me.ListBox1
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left + Target.Width
                .Width = Target.Width
                .Height = Target.Height * 5
            End With
            '============================================================================
            '
            '       根据点击的文本框,智能显示相应的listbox
            '       对应关系:
            '       Column = 2 ----------> 地区 cells=1
            '       Column =3-5 ---------> 餐饮 cells=3
            '       Column =6-7 ---------> 住宿 cells=5
            '       Column =8-17 --------> 景点 cells=7
            '       Column =18-20 -------> 购物点 cells=9
            '
            '============================================================================
        If Target.Column = 2 Then
            With Me.ListBox1
                For i = 2 To Sheet8.Range("A65536").End(xlUp).Row
                    .AddItem Sheet8.Cells(i, 1).Value
                Next
            End With
        ElseIf Target.Column > 2 And Target.Column < 6 Then
            With Me.ListBox1
                For i = 2 To Sheet8.Range("C65536").End(xlUp).Row
                    .AddItem Sheet8.Cells(i, 3).Value
                Next
            End With
        ElseIf Target.Column > 5 And Target.Column < 8 Then
            With Me.ListBox1
                For i = 2 To Sheet8.Range("E65536").End(xlUp).Row
                    .AddItem Sheet8.Cells(i, 5).Value
                Next
            End With
        ElseIf Target.Column > 7 And Target.Column < 18 Then
            With Me.ListBox1
                For i = 2 To Sheet8.Range("G65536").End(xlUp).Row
                    .AddItem Sheet8.Cells(i, 7).Value
                Next
            End With
        ElseIf Target.Column > 17 And Target.Column < 21 Then
            With Me.ListBox1
                For i = 2 To Sheet8.Range("I65536").End(xlUp).Row
                    .AddItem Sheet8.Cells(i, 9).Value
                Next
            End With
        Else
            Me.ListBox1.Clear
            Me.TextBox1 = ""
            Me.ListBox1.Visible = False
            Me.TextBox1.Visible = False
        End If
    
End Sub

 

'数据表

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    Dim myStr As String
    With Target
        If .Column <> 5 Or .Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Sheet3.Range("A:A"), .Value) > 1 Then
            .Value = ""
            MsgBox "不能输入重复的企业名称!", 64
            Exit Sub
        End If
        For i = 1 To Len(.Value)
            If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Then
                myStr = myStr & LChin(Mid$(.Value, i, 1))
            Else
                myStr = myStr & LCase(Mid$(.Value, i, 1))
            End If
        Next
        .Offset(, 1).Value = myStr
    End With
 End Sub