Täytä luetteloruutu ainutlaatuisilla arvoilla laskentataulukosta käyttämällä Microsoft Excelin VBA: ta

Anonim

Tässä artikkelissa luomme luetteloruudun käyttäjämuodossa ja lataamme siihen arvot päällekkäisten arvojen poistamisen jälkeen.

Raakatiedot, jotka lisäämme luetteloruutuun, koostuvat nimistä. Tämä raakatieto sisältää päällekkäisyyttä määritellyissä nimissä.

Tässä esimerkissä olemme luoneet käyttäjämuodon, joka koostuu luetteloruudusta. Tämä luetteloruutu näyttää yksilölliset nimet näytetiedoista. Aktivoi käyttäjälomake napsauttamalla Lähetä -painiketta.

Tämä käyttäjämuoto palauttaa käyttäjän valitseman nimen viesti -ruudussa.

Looginen selitys

Ennen nimien lisäämistä luetteloruutuun olemme poistaneet päällekkäiset nimet kokoelmaobjektilla.

Olemme poistaneet päällekkäiset merkinnät seuraavasti:-

  1. Lisätty nimet Excel -taulukon määritetystä alueesta kokoelmaobjektiin. Keräysobjektiin emme voi lisätä päällekkäisiä arvoja. Joten Collection -objekti heittää virheen kohdatessaan päällekkäisiä arvoja. Virheiden käsittelemiseksi olemme käyttäneet virheilmoitusta ”Virhe jatka seuraavaksi”.

  2. Kun kokoelma on valmisteltu, lisää kaikki kokoelman kohteet taulukkoon.

  3. Lisää sitten kaikki taulukkoelementit luetteloruutuun.

Seuraa koodia alla

 Option Explicit Sub käynnissä () UserForm1.Show End Sub 'Lisää alla oleva koodi käyttäjämuodossa Vaihtoehto Explicit Private Sub CommandButton1_Click () Dim var1 String Dim i As Integer' Silmukkaa läpi kaikki luetteloruudussa olevat arvot var1 Jos i = 0 ListBox1.ListCount - 1 Jos ListBox1.Selected (i) Sitten var1 = ListBox1.List (i) Exit For End If Next 'Poista käyttäjämuoto. Unload Me 'Näytetään valittu arvo MsgBox "Olet valinnut seuraavan nimen luetteloruudusta:" & var1 End Sub Private Sub UserForm_Initialize () Dim MyUniqueList As Variant, i As Long' Calling UniqueItemList function 'Alueen määrittäminen syöttöparametriksi MyUniqueList = UniqueItemList (Range ("A12: A100"), True) With Me.ListBox1 'Luetteloruudun sisällön tyhjentäminen .Clear' Arvojen lisääminen luetteloruutuun For i = 1 To UBound (MyUniqueList) .AddItem MyUniqueList (i) Next i ' Ensimmäisen kohteen valitseminen .ListIndex = 0 Lopeta Loppuosa Yksityinen toiminto UniqueItemList (InputRange As Range, _ HorizontalList As Boolean) Vaihtoehtona Dim cl As Range, cUnique As New Collection, i As Long 'Dynaamisen taulukon julistaminen Dim uList () As Vaihtoehto 'Tämän toiminnon ilmoittaminen haihtuvana' tarkoittaa, että funktio lasketaan uudelleen aina, kun laskutoimitus tapahtuu missä tahansa solussa Sovellus. cl In InputRange If cl.Value "" Sitten "Arvojen lisääminen kokoelmaan cUnique.Add cl.Value, CStr (cl.Value) End If Next cl" Alustavan arvon palauttaminen funktiolla UniqueItemList = "" Jos cUnique.Count> 0 Sitten 'Taulukon koon muuttaminen ReDim uList (1 To cUnique.Count)' Arvojen lisääminen kokoelmasta taulukkoon i = 1 To cUnique.Count uList (i) = cUnique (i) Seuraava i UniqueItemList = uList 'HorizontalList -arvon tarkistaminen' Jos arvo on tosi, UniqueItemList -arvon siirtäminen If Not HorizontalList Sitten UniqueItemList = _ Application.WorksheetFunction.Transpose (UniqueItemList) End If End Jos On Error GoTo 0 End Function 

Jos pidit tästä blogista, jaa se ystävillesi Facebookissa. Voit myös seurata meitä Twitterissä ja Facebookissa.

Haluaisimme kuulla sinusta, kerro meille, kuinka voimme parantaa työtämme ja parantaa sitä sinulle. Kirjoita meille sähköpostitse