Preencha uma caixa de listagem com valores exclusivos de uma planilha usando VBA no Microsoft Excel

Anonim

Neste artigo, vamos criar uma caixa de listagem no formulário do usuário e carregá-la com os valores após remover os valores duplicados.

Os dados brutos que inseriremos na caixa de listagem consistem em nomes. Esses dados brutos contêm duplicidade em nomes definidos.

Neste exemplo, criamos um formulário do usuário que consiste em uma caixa de listagem. Esta caixa de listagem exibirá nomes exclusivos dos dados de amostra. Para ativar o formulário do usuário, clique no botão enviar.

Este formulário de usuário retornará o nome selecionado pelo usuário como saída em uma caixa de mensagem.

Explicação lógica

Antes de adicionar nomes na caixa de listagem, usamos o objeto de coleção para remover nomes duplicados.

Realizamos as seguintes etapas para remover entradas duplicadas: -

  1. Adicionados nomes do intervalo definido na planilha do Excel para o objeto de coleção. No objeto de coleção, não podemos inserir valores duplicados. Portanto, o objeto Collection lança um erro ao encontrar valores duplicados. Para lidar com os erros, usamos a declaração de erro “On Error Resume Next”.

  2. Depois de preparar a coleção, adicione todos os itens da coleção ao array.

  3. Em seguida, insira todos os elementos da matriz na caixa de listagem.

Siga abaixo para o código

 Option Explicit Sub running () UserForm1.Show End Sub 'Adicionar o código abaixo no formulário do usuário Option Explicit Private Sub CommandButton1_Click () Dim var1 As String Dim i As Integer' Repetindo todos os valores presentes na caixa de listagem 'Atribuindo o valor selecionado à variável var1 For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected (i) Then var1 = ListBox1.List (i) Sair para End If Next 'Descarrega o formulário do usuário. Unload Me 'Exibindo o valor selecionado MsgBox "Você selecionou o seguinte nome na caixa de listagem:" & var1 End Sub Private Sub UserForm_Initialize () Dim MyUniqueList As Variant, i As Long' Chamando a função UniqueItemList 'Atribuindo o intervalo como parâmetro de entrada MyUniqueList = UniqueItemList (Range ("A12: A100"), True) With Me.ListBox1 'Limpando o conteúdo da List Box .Clear' Adicionando valores na List Box para i = 1 To UBound (MyUniqueList) .AddItem MyUniqueList (i) Next i ' Selecionando o primeiro item .ListIndex = 0 End With End Sub Função privada UniqueItemList (InputRange As Range, _ HorizontalList As Boolean) As Variant Dim cl As Range, cUnique As New Collection, i As Long 'Declarando uma matriz dinâmica Dim uList () As Variante 'Declarando esta função como volátil' significa que a função será recalculada sempre que o cálculo ocorrer em qualquer célula Application.Volatile On Error Resume Next 'Adicionando itens à coleção' Apenas um item exclusivo será inserido 'A inserção de um item duplicado resultará em um erro Para Cada cl In InputRange If cl.Value "" Then 'Adicionando valores na coleção cUnique.Add cl.Value, CStr (cl.Value) End If Next cl' Inicializando o valor retornado pela função UniqueItemList = "" If cUnique.Count> 0 Then 'Redimensionar o tamanho do array ReDim uList (1 To cUnique.Count)' Inserindo valores da coleção para o array For i = 1 To cUnique.Count uList (i) = cUnique (i) Next i UniqueItemList = uList 'Verificar o valor de HorizontalList' Se o valor for verdadeiro, transpondo o valor de UniqueItemList If Not HorizontalList Then UniqueItemList = _ Application.WorksheetFunction.Transpose (UniqueItemList) End If End If On Erro GoTo 0 End Function 

Se você gostou deste blog, compartilhe com seus amigos no Facebook. Além disso, você pode nos seguir no Twitter e no Facebook.

Gostaríamos muito de ouvir de você, diga-nos como podemos melhorar nosso trabalho e torná-lo melhor para você. Escreva para nós no site de e-mail