CAIXA DE COMBINAÇÃO no excel 2010

Question

Preciso criar uma caixa de combinação com apenas os registros exclusivos de um determinada coluna. Quando eu monto a caixa ela lista todos os registros, mesmo os que estão repetidos. Como faço para só aparecerem os exclusivos?

Answer 1

Private Sub UserForm_Initialize()
    Const csCol As String = "A"
    
    Dim lRow As Long
    Dim ws As Excel.Worksheet
    Dim l As Long
    Dim cItems As VBA.Collection
    Dim sItem As String
    
    Set cItems = New VBA.Collection
    Set ws = ThisWorkbook.Worksheets("Plan1")
    With ws
        On Error Resume Next
        'Considerando uma linha de cabeçalho:
        For lRow = 2 To .Cells(.Rows.Count, csCol).End(xlUp).Row
            sItem = CStr(.Cells(lRow, csCol))
            cItems.Add sItem, sItem
        Next lRow
        On Error GoTo 0
    End With
    
    For l = 1 To cItems.Count
        Me.ComboBox1.AddItem cItems(l)
    Next l
    
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Prezado Felipe,

Eu já tinha visto uma resposta sua sobre este tema e tentei usar a macro que publicou mas ela não teve o efeito desejado. Eu tenho uma tabela que faz a consulta com uma caixa de combinação procurando os nomes das industrias na coluna B cujo titulo está na celula B2 e o conteudo se estende da B3 à B52000 (é uma tabela bem grande). A ideia é que ao selecionar o nome da industria na caixa de combinação (não estou usando formulario e sim um controle AtiveX) aparecessem apenas os registros unicos (neste caso na coluna toda deve ter no máximo 11 nomes de industrias) pois o mesmo nome é repetido várias vezes.

Acredito que esta macro que colocou seja para um formulário, eu tentei a outra macro que acredito que seja para um controle AtiveX mas não funcionou.

Answer 3

Por se tratar de um controle ActiveX, você deverá povoar esse controle, na minha opinião, no evento Worksheet_Activate.

E como são muitos registros, troquei o laço de células por um de array para a rotina não demorar a executar.

Private Sub Worksheet_Activate()
    Const csCol As String = "A"
    
    Dim lLast As Long
    Dim l As Long
    Dim cItems As VBA.Collection
    Dim vItem As Variant
    Dim vList As Variant
    
    Set cItems = New VBA.Collection
    lLast = Cells(Cells.Rows.Count, csCol).End(xlUp).Row
    vList = Cells(3, csCol).Resize(lLast - 3 + 1)
    
    On Error Resume Next
    For Each vItem In vList
        cItems.Add vItem, vItem
    Next vItem
    On Error GoTo 0
    
    ActiveSheet.ComboBox1.Clear
    For l = 1 To cItems.Count
        ActiveSheet.ComboBox1.AddItem cItems(l)
    Next l
    
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 4

Use este código, ele é mais rápido:

Private Sub Worksheet_Activate()
    Const csCol As String = "A"
    
    Dim lLast As Long
    Dim vList As Variant
    
    Application.ScreenUpdating = False
    
    lLast = Cells(Cells.Rows.Count, csCol).End(xlUp).Row
    Cells(3, csCol).Resize(lLast - 3 + 1).Copy
    With Workbooks.Add.Worksheets(1)
        .Range("A1").PasteSpecial xlValues
        .Columns("A").RemoveDuplicates Columns:=1, Header:=xlNo
        lLast = .Cells(.Rows.Count, "A").End(xlUp).Row
        vList = .Range("A1").Resize(lLast)
        .Parent.Close False
        ActiveSheet.ComboBox1.List = vList
    End With
    
    Application.ScreenUpdating = True
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 5

PRezado Felipe,

Estou com duvidas onde colocar esse código para que funcione quando eu clico no botão (setinha) da caixa de combinação. Tem alguma forma de eu enviar um arquivo para você ver? eu diminuiu substancialmente o banco de dados para não ficar muito grande e pesado o arquivo, assim você poderia ver o que eu fiz para contornar o problema mas acredito que a sua solução é bem mais pratica e funcional, só que não consegui implantá-la.

Answer 6

Disponibilize sua pasta de trabalho aqui usando o OneDrive ou SendSpace.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 7

Boa tarde,

Apesar desta publicação ser antiga, eu estou a ter o mesmo tipo de problema.

Será que podes dar uma vista de olhos?

Obrigado