Blog Archive
-
▼
2005
(103)
-
▼
abril
(16)
- VBA: Ainda a UDF
- VBA: UDFs
- Excel: Hyperlink personalizado
- Excel: Uma solução diferente de SUMPRODUCT: a util...
- Excel: Ainda a Função SUMPRODUCT()
- VBA: Blink Label
- VBA: Label1.Caption
- VBA: O Método ActiveWorkbook.SaveAs Filename
- VBA Msg
- VBA: Centrar texto numa MsgBox
- VBA: Abrir procedimento com valor numa determinada...
- VBA: Colocar a Data numa célula
- VBA: Filtro numa ListBox II
- VBA: Filtro numa ListBox
- VBA: Filtrar por critério
- VBA: Limpar conteúdos
-
▼
abril
(16)
About Me
Com tecnologia do Blogger.
Seguidores
Estatisticas
2005-04-06
VBA: Filtro numa ListBox
6:07 da tarde |
Publicada por
JRod - PORTUGAL |
Editar mensagem
Se pretendermos que o(s) nome(s) filtrados apareçam numa ListBox na WorkSheet, criam-se: uma ListBox e um botão de comando, ambos a partir do Control ToolBox. Depois, com um pouco de VBA, podemos efectuar o filtro, como nos mostra a seguinte sequência:
1º - Para chamar o procedimento:
2º - Define-se o filtro:
3º - O resultado será:
O Código:
Private Sub CommandButton1_Click()
Dim rng As Range
Dim strProc As String
On Error Resume Next
Sheets("Sheet2").Columns(1).ClearContents
With Sheets("Sheet1")
strProc = InputBox("Digite a(s) letra(s) pretendidas e asterisco [ex. Jo*]ou asterisco para todos")
Range("A:A").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=strProc, Operator:=xlAnd
Selection.Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("A:A")
Range("A1").Select
Selection.AutoFilter
End With
With Sheets("Sheet2")
Set rng = .Range(.Cells(2, 2), .Cells(Rows.Count, 1).End(xlUp))
End With
Sheets("Sheet1").ListBox1.List = rng.Value
End Sub
NOTA: como se pode verificar, é utilizada uma segunda Sheet (Sheet2) para onde passa o filtro, o qual, por sua vez, alimenta a ListBox. Sempre que se efectua um novo filtro, o conteúdo da coluna 1 da Sheet2 é apagado, conforme mostra o procedimento, logo no seu início, com o código Sheets("Sheet2").Columns(1).ClearContents
1º - Para chamar o procedimento:
2º - Define-se o filtro:
3º - O resultado será:
O Código:
Private Sub CommandButton1_Click()
Dim rng As Range
Dim strProc As String
On Error Resume Next
Sheets("Sheet2").Columns(1).ClearContents
With Sheets("Sheet1")
strProc = InputBox("Digite a(s) letra(s) pretendidas e asterisco [ex. Jo*]ou asterisco para todos")
Range("A:A").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=strProc, Operator:=xlAnd
Selection.Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("A:A")
Range("A1").Select
Selection.AutoFilter
End With
With Sheets("Sheet2")
Set rng = .Range(.Cells(2, 2), .Cells(Rows.Count, 1).End(xlUp))
End With
Sheets("Sheet1").ListBox1.List = rng.Value
End Sub
NOTA: como se pode verificar, é utilizada uma segunda Sheet (Sheet2) para onde passa o filtro, o qual, por sua vez, alimenta a ListBox. Sempre que se efectua um novo filtro, o conteúdo da coluna 1 da Sheet2 é apagado, conforme mostra o procedimento, logo no seu início, com o código Sheets("Sheet2").Columns(1).ClearContents