Erro Cruel

[mrfg2000]

Olá galera! Agradeço por lerem este post.

Preciso de uma rotina para carregar uma lista de nomes em um Listbox, que encontra-se entre A2 até A65000.

obs: Neste Range tem alguns nomes repetidos que não poderão ser inclusos no Listbox, caso já tenha o mesmo.

a lógica seria essa:

A) verifica na lista se o nome já foi incluso no listbox , se ainda não foi, incluir , se já foi , pular para proximo nome.

Para fazer este teste, coloque um Listbox em um userform.

Tentei o código conforme abaixo descrito, mas não consigo. poderia me ajudar AMIGOS .

Private Sub UserForm_initialize()

Dim cel_inicio As String, cel_final As String

Dim lihas As Integer

Dim controle As Boolean

cel_inicio = "A2"

cel_final = "A65000"

Set inicio = Range(cel_inicio)

Set Final = Range(cel_final)

With Me.ListBox1

While inicio.Row < Final.Row

linhas = Me.ListBox1.ListCount

For i = 0 To linhas - 1

If linhas > 0 Then

Me.ListBox1.Selected (i)

Else

If inicio.Value = Me.ListBox1.ListIndex Then

'Se o nome foi achado em alguma posição do listbox, a variável

'controle vai para TRUE (ela será utilizada abaixo para controle)

controle = True

Exit For

End If

End If

Next

If controle = False Then

.AddItem inicio.Value

Set inicio = inicio.Offset(1, 0)

Else

controle = False

Set inicio = inicio.Offset(1, 0)

End If

Wend

End With

End Sub

[João.Neto]

Usa este código:

Dim lista() As String

Private Sub UserForm_initialize()

Dim rng As Range, r As Range

Set rng = ThisWorkbook.Worksheets("Plan1").Range("A2").CurrentRegion.Offset(1, 0) _

.Resize(ThisWorkbook.Worksheets("Plan1").Range("A2").CurrentRegion.Offset(1, 0).Rows.Count, _

ThisWorkbook.Worksheets("Plan1").Range("A2").CurrentRegion.Offset(1, 0).Columns.Count)

ReDim lista(0)

For Each r In rng.Rows

If verificaItem(r.Value) = False Then

ListBox1.AddItem r.Value

End If

Next r

End Sub

Public Function verificaItem(item As String) As Boolean

Dim i As Integer

For i = LBound(lista) To UBound(lista)

If lista(i) = item Then

verificaItem = True

Exit Function

End If

Next i

ReDim Preserve lista(UBound(lista, 1) + 1)

lista(UBound(lista)) = item

End Function

Editado Setembro 14, 2008 por João.Neto