如何自动完成单词

时间:2015-10-23 04:31:31

标签: excel-vba vba excel

我的朋友们, 我有两张纸(Sheet1& Sheet2)。在sheet2,B列所有员工姓名, 并且在表格1中有一个表格要填写,在单元格C3中,需要写下工作人员的姓名。我想要做的是#34;当我写出员工姓名的首字母时,我希望Excel给我基于Sheet2,B栏的选项名称。就像我们在谷歌写任何东西时一样,Google给出了选项。

先谢谢你的帮助。

1 个答案:

答案 0 :(得分:0)

另一个想法是使用VBA,我已经更新了byundt's 代码。 无法立即显示自动填充,但您可以键入一些字符,当您播放时输入代码检查列表,如果是一个匹配,则自动填充数据,否则询问用户是否验证缺少的名称并添加它到列表o删除最后输入的值。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cel As Range, match1 As Range, match2 As Range, rg As Range, targ As Range
    Set targ = Intersect(Target, Range("C:C")) 'Watch the cells in column C
    Set sh = Worksheets("registry") 'the sheet2 where you have the list of names

    Set rg = sh.Range("A2", "A" & sh.Range("A1").End(xlDown).Row)
    If targ Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error GoTo errhandler

    For Each cel In targ
        If Not IsError(cel) Then
            If cel <> "" And cel <> " " And Right(cel, 1) <> Chr(10) Then
                Set match1 = Nothing
                Set match1 = rg.Find(cel & "*", lookat:=xlWhole, MatchCase:=False)
                If Not match1 Is Nothing Then
                    Set match2 = rg.FindNext(after:=match1)
                    If match2.Address = match1.Address Then
                        cel = match1
                    Else
                        cel.Activate
                        Application.SendKeys ("{F2}")
                    End If
                Else 'No matches found. The value will be added of the end of range list
                    msg = "The value """ & Target & """ is not in list, " & vbCrLf & "do you whant to add this item??"
                    response = MsgBox(msg, 4, "Update list")
                    If response = 6 Then
                        sh.Range("A" & sh.Range("A1").End(xlDown).Row + 1) = Target
                    Else
                        Range(Target.Address) = ""
                    End If

                End If
            Else
                If cel <> "" And Right(cel, 1) = Chr(10) Then cel = Left(cel, Len(cel) - 1)
            End If
        End If
    Next cel

errhandler:     Application.EnableEvents = True
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub