Kako samodejno dokončati besedilno polje pri tipkanju v Excelu?

Excel si privzeto zapomni, kaj ste vnesli v celice trenutnega delovnega lista, in naslednjič samodejno dokonča to vsebino, ko vtipkate sorodno začetno črko v novo celico. Če pa želite, da se vsa vsebina, ki ste jo vnesli na delovni list, samodejno dokonča v besedilnem polju (ActiveX Control), kako bi to lahko storili? V tem članku je opisana metoda VBA, ki vam pomaga pri samodokončanju besedilnega polja pri vnašanju začetne črke.

Samodejno dokončajte polje z besedilom, ko tipkate s kodo VBA

Samodejno dokončajte polje z besedilom, ko tipkate s kodo VBA

Neverjetno! Uporaba učinkovitih zavihkov v Excelu Tako kot Chrome, Firefox in Safari!

Prihranite 50% svojega časa in vsak dan zmanjšajte na tisoče klikov z miško!

Naredite naslednje, če želite, da se besedilno polje samodejno dokonča, ko vnesete začetno črko v polje.

1. Vstavite besedilno polje s klikom Razvojni > Vstavi > Besedilno polje (nadzor ActiveX). Oglejte si posnetek zaslona:

2. In nato kliknite Razvojni > Vstavi > List List (ActiveX Control) če želite v trenutni delovni list vstaviti polje s seznamom. Oglejte si posnetek zaslona:

3. Z desno miškino tipko kliknite jeziček lista in nato kliknite Ogled kode iz kontekstnega menija, kot je prikazano spodaj.

4. V Ljubljani Microsoft Visual Basic za aplikacije okno, kopirajte in prilepite spodnjo kodo VBA v okno Code. In nato kliknite Orodja > Referencein nato preverite Microsoft Scripting Runtime polje v Reference - VBAProject pogovorno okno. Oglejte si posnetek zaslona:

Koda VBA: med tipkanjem samodejno dokončajte polje z besedilom

Dim xRg As Range
Dim xDic As New Dictionary
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Me.TextBox1.Value = Me.ListBox1.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xVal As String
    On Error Resume Next
    If IsNumeric(Target.Value) Then
        xVal = Str(Target.Value)
    Else
        xVal = Target.Value
    End If
    If xVal <> "" Then
        If Not xDic.Exists(xVal) Then
            xDic.Add xVal, xVal
        End If
    End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Me.ListBox1.Visible = False
End Sub
Private Sub Worksheet_Activate()
    Dim I As Long
    Dim xStr As String
    On Error Resume Next
    If xRg Is Nothing Then
        Set xRg = ActiveSheet.UsedRange
    End If
    Me.ListBox1.Visible = False
    xDic.RemoveAll
    With Me.ListBox1
        For I = 1 To xRg.Count
            xStr = xRg(I).Value
            If xStr <> "" Then
                .AddItem xStr
                If Not xDic.Exists(xStr) Then
                    xDic.Add xStr, xStr
                End If
            End If
        Next
    End With
End Sub
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    With Me.ListBox1
        .Top = Me.TextBox1.Top
        .Left = Me.TextBox1.Left + Me.TextBox1.Width
        .Width = Me.TextBox1.Width
    End With
    TextBoxVal Me.TextBox1.Object
End Sub
Sub TextBoxVal(xTextBox As Variant)
    Dim I As Long
    Dim xStr As String
    On Error Resume Next
    Application.ScreenUpdating = False
    If xRg Is Nothing Then Exit Sub
    Me.ListBox1.Clear
    xStr = xTextBox.Value
    If xStr = "" Then
        Me.ListBox1.Visible = False
        Application.EnableEvents = True
        Exit Sub
    End If
    For I = 0 To UBound(xDic.Items)
        If Left(xDic.Items(I), Len(xStr)) = xStr Then
            Me.ListBox1.AddItem xDic.Items(I)
        End If
    Next
    Me.ListBox1.Visible = True
    If Me.ListBox1.ListCount > 0 Then
        With xTextBox
            .Value = Me.ListBox1.List(0)
            .SelStart = Len(xStr)
            .SelLength = Len(Me.ListBox1.List(0))
        End With
    End If
    Me.ListBox1.Activate
    Me.ListBox1.Selected(0) = True
    Application.ScreenUpdating = True
End Sub
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        Me.TextBox1.Value = Me.ListBox1.Value
    End If
End Sub

Opombe: V kodi, ListBox1 in Besedilo1 sta ime seznamskega polja in besedilnega polja, ki ste ga vstavili v svoj delovni list.

5. Pritisnite druga + Q tipke za izhod iz Microsoft Visual Basic za aplikacije okno.

6. Izklopite način oblikovanja s klikom Razvojni > Način oblikovanja v delovnem listu.

7. Zdaj se pomaknite na drug delovni list in se nato vrnite na prejšnji delovni list, da omogočite kodo VBA.

Od zdaj naprej. Ko vnesete začetno črko v besedilno polje, bodo vsa besedila, ki se začnejo s tisto črko, ki ste jo vnesli v delovni list, navedena v polju s seznamom na desni strani besedilnega polja. Dvokliknite želenega, da ga vnesete v besedilno polje. Oglejte si posnetek zaslona:

Opombe: Lahko uporabite Up or navzdol puščično tipko za premikanje med vsemi besedili s samodokončanjem v seznamskem polju in nato pritisnite Vnesite tipko, da jo vnesete v besedilno polje.

Sorodni članki:

• Kako samodejno izbrati besedilo v besedilnem polju, ko je izbrano v Excelu?
• Kako počistiti vsebino besedilnega polja ob kliku v Excelu?
• Kako združiti besedila več celic v besedilno polje v Excelu?
• Kako onemogočiti urejanje v besedilnem polju, da preprečite vnos uporabnika v Excelu?
• Kako oblikovati besedilno polje v odstotkih v Excelu?

Najboljša orodja za pisarniško produktivnost

Kutools za Excel rešuje večino vaših težav in poveča produktivnost za 80%

• Ponovna uporaba: Hitro vstavite zapletene formule, grafikoni in vse, kar ste že uporabljali; Šifriraj celice z geslom; Ustvari poštni seznam in pošiljanje e-pošte ...
• Vrstica Super Formula (enostavno urejanje več vrstic besedila in formule); Bralna postavitev (enostavno branje in urejanje velikega števila celic); Prilepite v filtrirani obseg...
• Združi celice / vrstice / stolpce brez izgube podatkov; Vsebina razdeljenih celic; Združi podvojene vrstice / stolpce... prepreči podvojene celice; Primerjaj obsege...
• Izberite Duplicate ali Unique Vrstice; Izberite prazne vrstice (vse celice so prazne); Super Find in Fuzzy Find v mnogih delovnih zvezkih; Naključna izbira ...
• Natančna kopija Več celic brez spreminjanja sklica formule; Samodejno ustvarjanje referenc na več listov; Vstavi oznake, Potrditvena polja in še več ...
• Izvleček besedila, Dodaj besedilo, Odstrani po položaju, Odstrani presledek; Ustvari in natisni vmesne seštevke strani Pretvarjanje med vsebino celic in komentarji...
• Super filter (shranite in uporabite sheme filtrov za druge liste); Napredno razvrščanje glede na mesec / teden / dan, pogostost in drugo; Poseben filter s krepko, ležeče ...
• Združite delovne zvezke in delovne liste; Spoji tabele na podlagi ključnih stolpcev; Razdelite podatke na več listov; Paketna pretvorba xls, xlsx in PDF...
• Več kot 300 zmogljivih funkcij. Podpira Office / Excel 2007-2019 in 365. Podpira vse jezike. Preprosta namestitev v vašem podjetju ali organizaciji. Vse funkcije 30-dnevnega brezplačnega preskusa. 60-dnevno jamstvo za vračilo denarja.

Preberite več ... Brezplačen prenos... Nakup ... 

---

Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo

• Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
• Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
• Poveča vašo produktivnost za 50% in vsak dan zmanjša na stotine klikov z miško!

Preberite več ... Brezplačen prenos... Nakup ...