Riempire una casella di riepilogo con i valori unici da un foglio di lavoro utilizzando VBA in Microsoft Excel
In questo articolo, creeremo una casella di riepilogo in userform e la caricheremo con i valori dopo aver rimosso i valori duplicati.
I dati grezzi che inseriremo nella casella di riepilogo sono costituiti da nomi. Questi dati grezzi contengono doppiezza nei nomi definiti.
In questo esempio, abbiamo creato un modulo utente che consiste in List Box.
Questa casella di riepilogo visualizzerà nomi univoci dai dati di esempio. Per attivare il modulo utente, fare clic sul pulsante Invia.
Questo modulo utente restituirà il nome selezionato dall’utente come output in una finestra di messaggio.
Spiegazione logica
Prima di aggiungere nomi nella casella di riepilogo, abbiamo utilizzato l’oggetto raccolta per rimuovere i nomi duplicati.
Abbiamo eseguito i seguenti passaggi per rimuovere le voci duplicate: -. Aggiunti nomi dall’intervallo definito nel foglio Excel all’oggetto raccolta. Nell’oggetto raccolta, non possiamo inserire valori duplicati. Quindi, l’oggetto Collection genera un errore quando rileva valori duplicati. Per gestire gli errori, abbiamo utilizzato l’istruzione di errore “On Error Resume Next”.
-
Dopo aver preparato la raccolta, aggiungere tutti gli elementi della raccolta all’array.
-
Quindi, inserisci tutti gli elementi della matrice nella casella di riepilogo.
Segui sotto per il codice
Option Explicit
Sub running()
UserForm1.Show
End Sub
'Add below code in userform
Option Explicit
Private Sub CommandButton1_Click()
Dim var1 As String
Dim i As Integer
'Looping through all the values present in the list box
'Assigning the selected value to variable var1
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
var1 = ListBox1.List(i)
Exit For
End If
Next
'Unload the userform.
Unload Me
'Displaying the selected value
MsgBox "You have selected following name in the List Box : " & var1
End Sub
Private Sub UserForm_Initialize()
Dim MyUniqueList As Variant, i As Long
'Calling UniqueItemList function
'Assigning the range as input parameter
MyUniqueList = UniqueItemList(Range("A12:A100"), True)
With Me.ListBox1
'Clearing the List Box content
.Clear
'Adding values in the List Box
For i = 1 To UBound(MyUniqueList)
.AddItem MyUniqueList(i)
Next i
'Selecting the first item
.ListIndex = 0
End With
End Sub
Private Function UniqueItemList(InputRange As Range, _
HorizontalList As Boolean) As Variant
Dim cl As Range, cUnique As New Collection, i As Long
'Declaring a dynamic array
Dim uList() As Variant
'Declaring this function as volatile
'Means function will be recalculated whenever calculation occurs in any cell
Application.Volatile
On Error Resume Next
'Adding items to collection
'Only unique item will be inserted
'Inserting duplicate item will through an error
For Each cl In InputRange
If cl.Value <> "" Then
'Adding values in collection
cUnique.Add cl.Value, CStr(cl.Value)
End If
Next cl
'Initializing value return by the function
UniqueItemList = ""
If cUnique.Count > 0 Then
'Resizing the array size
ReDim uList(1 To cUnique.Count)
'Inserting values from collection to array
For i = 1 To cUnique.Count
uList(i) = cUnique(i)
Next i
UniqueItemList = uList
'Checking the value of HorizontalList
'If value is true then transposing value of UniqueItemList
If Not HorizontalList Then
UniqueItemList = _
Application.WorksheetFunction.Transpose(UniqueItemList)
End If
End If
On Error GoTo 0
End Function
Se ti è piaciuto questo blog, condividilo con i tuoi amici su Facebook e Facebook.
Ci piacerebbe sentire la tua opinione, facci sapere come possiamo migliorare il nostro lavoro e renderlo migliore per te. Scrivici a [email protected]