Notifications

Clear all

ComboBox sem dados repetidos e sem Células em Branco

VBA & Macros

Post Recente por refernande 8 anos atrás

7 Posts

2 Usuários

0 Likes

1,651 Visualizações

RSS

refernande

(@refernande)

Posts: 35

Eminent Member

Topic starter

Boa Tarde
Estou com uma dificuldade em resolver um problema em uma combobox, tenho uma coluna mais tb tem muitas células em branco, como deixar que a combobox sem dados repetidos e ordem crescente?
Verificando já nos tópicos abertos não achei nenhum que poderia me auxiliar.
Segue planilha anexo.

Postado : 08/09/2016 1:48 pm

Fernando Fernandes

(@fernandofernandes)

Posts: 43753

Illustrious Member

Adicione a rotina abaixo no seu formulário:

Private Sub UserForm_Initialize()
    Dim OCOLLECTION As New Collection
    Dim VARVALUE As Variant
    Dim I, ULTLINHA As Long

    Me.Cd_Status.Clear
    
    ULTLINHA = Sheets("PQ").Range("B1048576").End(xlUp).Row
    
    On Error Resume Next
    
    For Each VARVALUE In Sheets("PQ").Range("B5:B" & ULTLINHA)
        
        If VARVALUE <> "" Then
            OCOLLECTION.Add CStr(VARVALUE), CStr(VARVALUE)
       End If
       
    Next
    
    For I = 1 To OCOLLECTION.Count
        Cd_Status.AddItem OCOLLECTION.Item(I)
    Next
    
End Sub

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 08/09/2016 8:44 pm

refernande

(@refernande)

Posts: 35

Eminent Member

Topic starter

Bom dia Mauro Coutinho
Funcionou perfeitamente, mais alguma forma dele ordenar combobox por ordem alfabética?

Att.

Postado : 09/09/2016 4:39 am

Fernando Fernandes

(@fernandofernandes)

Posts: 43753

Illustrious Member

No final da Rotina que carrega o Combobox após o último Next, adicione a seguinte instrução que chama a rotina para Ordenar :

Call OrdenarComboBox

Sub OrdenarComboBox()
    Dim iForsta, iSista As Integer
    Dim i, j As Integer
    Dim sTemp As String
    
    iForsta = 0
    iSista = Cd_Status.ListCount - 1

    For i = iForsta To iSista - 1
        For j = i + 1 To iSista
            If Cd_Status.List(i) > Cd_Status.List(j) Then
                sTemp = Cd_Status.List(j)
                Cd_Status.List(j) = Cd_Status.List(i)
                Cd_Status.List(i) = sTemp
            End If
        Next j
    Next i
    
End Sub

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 09/09/2016 5:43 am

refernande

(@refernande)

Posts: 35

Eminent Member

Topic starter

Muito Obrigado pela ajuda ai Mauro Coutinho

Ajudou d++

Mais uma dica puder me ajudar

Nesse códico para eu incluir mais três combobox?

Cd_Status: Coluna B
CdRp: Já está pronto
CdSegmento: Coluna E

Ai sim encerraria minha planilha.

Att.

Postado : 09/09/2016 12:04 pm

Fernando Fernandes

(@fernandofernandes)

Posts: 43753

Illustrious Member

fernande, como nas colunas que citou as quantidades de linhas são diferentes, o ideal é fazer uma rotina para cada combo e chama-las no Initialize do Formuçário, troque pelas rotinas abaixo e veja se é isto :

Private Sub UserForm_Initialize()
    
    Call Combo_CdRp
    Call Combo_Cd_Status
    Call Combo_CdSegmento
    
End Sub

Sub Combo_CdRp()
    Dim OCOLLECTION As New Collection
    Dim VARVALUE As Variant
    Dim i, ULTLINHA As Long

    Me.CdRp.Clear

    ULTLINHA = Sheets("PQ").Range("C1048576").End(xlUp).Row

    On Error Resume Next

    For Each VARVALUE In Sheets("PQ").Range("C5:C" & ULTLINHA)

        If VARVALUE <> "" Then
            OCOLLECTION.Add CStr(VARVALUE), CStr(VARVALUE)
       End If

    Next

    For i = 1 To OCOLLECTION.Count
        CdRp.AddItem OCOLLECTION.Item(i)
    Next
    
    Call ordenarcombobox
    
End Sub

Sub Combo_Cd_Status()
    Dim OCOLLECTION As New Collection
    Dim VARVALUE As Variant
    Dim i, ULTLINHA As Long

    Me.Cd_Status.Clear

    ULTLINHA = Sheets("PQ").Range("B1048576").End(xlUp).Row

    On Error Resume Next

    For Each VARVALUE In Sheets("PQ").Range("B5:B" & ULTLINHA)

        If VARVALUE <> "" Then
            OCOLLECTION.Add CStr(VARVALUE), CStr(VARVALUE)
       End If

    Next

    For i = 1 To OCOLLECTION.Count
        Cd_Status.AddItem OCOLLECTION.Item(i)
    Next
    
    Call ordenarcombobox
    
End Sub

Sub Combo_CdSegmento()
    Dim OCOLLECTION As New Collection
    Dim VARVALUE As Variant
    Dim i, ULTLINHA As Long

    Me.CdSegmento.Clear

    ULTLINHA = Sheets("PQ").Range("E1048576").End(xlUp).Row

    On Error Resume Next

    For Each VARVALUE In Sheets("PQ").Range("E5:E" & ULTLINHA)

        If VARVALUE <> "" Then
            OCOLLECTION.Add CStr(VARVALUE), CStr(VARVALUE)
       End If

    Next

    For i = 1 To OCOLLECTION.Count
        CdSegmento.AddItem OCOLLECTION.Item(i)
    Next
    
    Call ordenarcombobox
    
End Sub

Sub ordenarcombobox()
    Dim iforsta, isista As Integer
    Dim i, j As Integer
    Dim stemp As String

    iforsta = 0
    isista = CdRp.ListCount - 1

    For i = iforsta To isista - 1
        For j = i + 1 To isista
            If CdRp.List(i) > CdRp.List(j) Then
                stemp = CdRp.List(j)
                CdRp.List(j) = CdRp.List(i)
                CdRp.List(i) = stemp
            End If
        Next j
    Next i

End Sub

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 09/09/2016 1:26 pm