Excel Exibir na ListBox apenas os dados visíveis (filtrados) na tabela

[MateusAC3]

Boa noite, quero listar os dados de uma tabela em uma ListBox, mas quando eu filtro a tabela ele continua mostrando tudo, mesmo os dados filtrados, como eu posso resolver isso?

 

Private Sub CommandButton1_Click()

Dim Sh As Worksheet
Dim i As Long

If txtQtd = "" Then
 txtQtd.SetFocus
Else

Set Sh = Worksheets("Teste")

'Primeira linha com valores (sem filtro na tabela)
i = 4 

Qtd = txtQtd
listTempo.Clear

 With Me.listTempo
  Do Until Sh.Cells(i, 4).Value = ""
   .AddItem Sh.Cells(i, 3).Value
   .List(.ListCount - 1, 1) = Sh.Cells(i, 4).Value
   .List(.ListCount - 1, 2) = Sh.Cells(i, 5).Value
   .List(.ListCount - 1, 3) = Sh.Cells(i, 6).Value
   .List(.ListCount - 1, 4) = Sh.Cells(i, 7).Value
   .List(.ListCount - 1, 5) = Qtd
   i = i + 1
  Loop
 End With

End If

End Sub

 

[Midori]

@MateusAC3 Para isso você pode testar se a linha está oculta,

 

If Not Sh.Cells(i, 4).EntireRow.Hidden Then

 

[MateusAC3]

Private Sub CommandButton1_Click()

Dim Sh As Worksheet
Dim i As Long

If txtQtd = "" Then
 txtQtd.SetFocus
Else
 Set Sh = Worksheets("Teste")
 i = 4 
 Qtd = txtQtd
 listTempo.Clear

 With Me.listTempo
  Do Until Sh.Cells(i, 4).Value = ""
   If Sh.Cells(i, 4).EntireRow.Hidden Then
    i = i + 1
   Else
    .AddItem Sh.Cells(i, 3).Value
    .List(.ListCount - 1, 1) = Sh.Cells(i, 4).Value
    .List(.ListCount - 1, 2) = Sh.Cells(i, 5).Value
    .List(.ListCount - 1, 3) = Sh.Cells(i, 6).Value
    .List(.ListCount - 1, 4) = Sh.Cells(i, 7).Value
    .List(.ListCount - 1, 5) = Qtd
    i = i + 1
   End If
  Loop
 End With

End If

End Sub

 

Deu certo, só tive q fazer uma adaptação, obrigado!

[Midori]

Em vez de fazer o incremento duas vezes, você pode fazer só uma vez fora da estrutura condicional.

[MateusAC3]

Private Sub CommandButton1_Click()

Dim Sh As Worksheet
Dim i As Long

If txtQtd = "" Then
 txtQtd.SetFocus
Else
 Set Sh = Worksheets("Teste")
 i = 4 
 Qtd = txtQtd
 listTempo.Clear

 With Me.listTempo
  Do Until Sh.Cells(i, 4).Value = ""
   If Not Sh.Cells(i, 4).EntireRow.Hidden Then
    .AddItem Sh.Cells(i, 3).Value
    .List(.ListCount - 1, 1) = Sh.Cells(i, 4).Value
    .List(.ListCount - 1, 2) = Sh.Cells(i, 5).Value
    .List(.ListCount - 1, 3) = Sh.Cells(i, 6).Value
    .List(.ListCount - 1, 4) = Sh.Cells(i, 7).Value
    .List(.ListCount - 1, 5) = Qtd
   End If
    i = i + 1
  Loop
 End With

End If

End Sub

É verdade, compliquei à toa

[OreiaG]

 

Segue uma opção, possivelmente de execução mais rápida, pois o Loop é feito SOMENTE nas células filtradas e não em TODAS as células da coluna D da tabela. Por exemplo, se a tabela é formada por 200 linhas com dados e após aplicar o Filtro somente 20 linhas ficam filtradas, o Loop será feito nas 20 células filtradas em D, e não nas 200 que formam a tabela.

 

Utiliza o método SpecialCells(xlCellTypeVisible).

 

Private Sub CommandButton1_Click() 'funcionou
 Dim Sh As Worksheet, c As Range
  If txtQtd = "" Then
   txtQtd.SetFocus
  Else
  Set Sh = Worksheets("Teste")
  Qtd = txtQtd
  listTempo.Clear
  With Me.listTempo
   For Each c In Sh.Range("D4:D" & Sh.Cells(Rows.Count, 4).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
    .AddItem c.Offset(, -1).Value
    .List(.ListCount - 1, 1) = c.Value
    .List(.ListCount - 1, 2) = c.Offset(, 1).Value
    .List(.ListCount - 1, 3) = c.Offset(, 2).Value
    .List(.ListCount - 1, 4) = c.Offset(, 3).Value
    .List(.ListCount - 1, 5) = Qtd
   Next c
  End With
End Sub

 

[OreiaG]

oops ... parece que faltou um End If

 

   End With

  End If

End Sub