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
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:
![](https://lh3.googleusercontent.com/blogger_img_proxy/AEn0k_vWUEAXZOQziMezwO2-VaEkyLDlbwZ0iC-dfH7BncPQ1qqeaNNvHilimxFlM1bxCd_3Y1WotRf0fbEHlwI0LZPD0C0LTF5UMrW2qdoKXWyPqmVtsw=s0-d)
2º - Define-se o filtro:
![](https://lh3.googleusercontent.com/blogger_img_proxy/AEn0k_vTo-KFftyE6hIGnckK1Jn9ivEtGTZS77cS5QVhRErPQqHeciTP0IpQe-eWCqQN_XK0PkKmXnOQJHt4O0fUznDpr8UYhTYsiAOUiAOTOMXJP90XfA=s0-d)
3º - O resultado será:
![](https://lh3.googleusercontent.com/blogger_img_proxy/AEn0k_sJh5vDKMcUw5y_sX8fUEqeIDsFfrAd-VVRAtzvMBpaXab2a6teYE68kH4mxgfi0drfopZ2I1JBHMlCcyW5QWYI1o9HGsw7P_sQhCsSn8XNYy5lrg=s0-d)
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