gamboaisrael,

Boa Tarde!

Veja o arquivo anexo. Ele serve para ListBox ou ComboBox.

Muito obrigado, Wagner!

Adaptei aqui e ficou show de bola.

Resposta rápida e eficiente, parabéns!!!

Boa tarde, Wagner.

Me desculpe ter reativado o tópico depois de marcá-lo como resolvido. O fato é que depois do primeiro momento eu adicionei o código à minha planilha real e passei a ter problemas.

Como você e os outros colegas que por acaso se interessarem no tópico poderão ver, as planilhas com as quais eu pretendo colocar o código abaixo para trabalhar são muito grandes. Este fato, acredito eu, levou a macro "Retira_Repetidos" a ficar muito lenta e, acredito eu, em algumas máquinas chegou a ocasionar o travamento do Excel. Sobretudo no 2003.

O tamanho das planilhas seria o motivo da lentidão?

É possível solucionar isso?

O código adaptado segue abaixo e a planilha será anexada mais tarde, pois tem mais de 2MB e fórum tá proibindo o upload. Terei que anexá-la ao chegar em casa.

Private Sub UserForm_Activate()
Dim MyList(5, 1)

With ComboBox1
.ColumnCount = 1
.ColumnWidths = 15
.Width = 45
.Height = 15
.ListRows = 5
End With

With ThisWorkbook.Worksheets("Temp")

MyList(1, 0) = .Range("A2")
MyList(2, 0) = .Range("A3")
MyList(3, 0) = .Range("A4")
MyList(4, 0) = .Range("A5")
End With

ComboBox1.List() = MyList

End Sub

Private Sub ComboBox1_Change()

lin = 2
ComboBox2.Clear

Application.ScreenUpdating = False

If ComboBox1 = "SC" Then
ThisWorkbook.Worksheets("SC").Select
ElseIf ComboBox1 = "PR" Then
ThisWorkbook.Worksheets("PR").Select
ElseIf ComboBox1 = "SP" Then
ThisWorkbook.Worksheets("SP").Select
ElseIf ComboBox1 = "MG" Then
ThisWorkbook.Worksheets("MG").Select
End If

Do Until ThisWorkbook.ActiveSheet.Cells(lin, 3) = ""
If UCase(ActiveSheet.Cells(lin, 3)) = UCase(ComboBox1) Then
ComboBox2.AddItem ActiveSheet.Cells(lin, 5)
Call Retira_Repetidos
End If

lin = lin + 1
Loop

End Sub

Sub Retira_Repetidos()
 
Application.ScreenUpdating = False

 Dim QtdeLinhas, x, z As Integer
 
 QtdeLinhas = ComboBox2.ListCount - 1

  For x = 0 To QtdeLinhas
    For z = 0 To QtdeLinhas
        If x <> z Then
            If z > QtdeLinhas Or x > QtdeLinhas Then Exit For
            If ComboBox2.List(x) = ComboBox2.List(z) Then
                ComboBox2.RemoveItem (z)
                QtdeLinhas = QtdeLinhas - 1
            End If
        End If
    Next z
  Next x
  
End Sub

Muito obrigado pela atenção.

Atenciosamente,

gamboaisrael.

Link para o download da planilha:

http://www.4shared.com/rar/hfQZjnYP/consolidado_planilhando.html

Abraços,

Link para o download da planilha:

http://www.4shared.com/rar/hfQZjnYP/consolidado_planilhando.html

Abraços,

gamboaisrael, da próxima vez que colocar um arquivo em sites tipo o "4shared" deixe com opção de "Publico" assim não precisamos nos cadastrar para baixa-lo.

Segue a rotina utilizando a "Classe Collection", em seu Formulário delete toddas as rotinas e troque pelos códigos abaixo :

Dim sEstado As String

Private Sub UserForm_Activate()
    Dim MyList(5, 1)
    
    With ComboBox1
    .ColumnCount = 1
    .ColumnWidths = 15
    .Width = 45
    .Height = 15
    .ListRows = 5
    End With
    
    With ThisWorkbook.Worksheets("Temp")
    
    MyList(1, 0) = .Range("A2")
    MyList(2, 0) = .Range("A3")
    MyList(3, 0) = .Range("A4")
    MyList(4, 0) = .Range("A5")
    End With
    
    ComboBox1.List() = MyList

End Sub

Private Sub ComboBox1_Change()

    sEstado = ComboBox1.Value

    Call PopulaCombo1
    
End Sub

Sub PopulaCombo1()

    Dim wsEstado As Worksheet
    
    Set wsEstado = Worksheets(sEstado)
    
    Me.ComboBox2.Clear

    Application.ScreenUpdating = False

    Dim OCOLLECTION As New Collection
    Dim VARVALUE As Variant
    Dim I, ULTLINHA As Long
    
    ULTLINHA = wsEstado.Range("A65536").End(xlUp).Row
    
    On Error Resume Next
    
    For Each VARVALUE In wsEstado.Range("E2:E" & ULTLINHA)
        OCOLLECTION.Add (VARVALUE), (VARVALUE)
    Next
    
    For I = 1 To OCOLLECTION.Count
        ComboBox2.AddItem OCOLLECTION.Item(I)
    Next
    
End Sub

Faça os testes e veja se melhora a performance.

Se a idéia é popular os outros combos encadeando com o primeiro, de uma olhada no Forum abaixo :
varios combobox encadeados
http://www.tomasvasquez.com.br/forum/vi ... JHePm_A9-I

[]s

Muito obrigado, Mauro.

Funcionou perfeitamente! Agradeço também a dica quanto aos controles dependentes!

Abração!