Home Excel - Downloads / Areas Restritas Excel VBA - AutoFiltros

Excel VBA - AutoFiltros

  • - Acesso Livre
  • Documentos

    Ordenar por : Nome | Data | Acessos [ Descendente ]

    Excel planilha vba autofiltro para folha de planilhas Excel planilha vba autofiltro para folha de planilhas

    popular!
    Adicionado em: 14/05/2011
    Modificado em: 14/05/2011
    Tamanho: 24.71 KB
    Downloads: 1212

    Saberexcel - O site de quem precisa aprender macros Microsoft Excel VBA

    Esse macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), filtra determinados ítens de uma tabela da folha de Planilha principal, para as referidas folhas de planilhas conforme critério na tabela, isto é, distribui dados para as folhas de planilhas correspondentes, filtrando os dados.
    Observe que o macro monta os cabeçalhos e retorna os dados relacionados a folha de planilha, montando um relatório para cada ítem e também
    organiza na ordem crescente por data, há uma subrotina para essa finalidade, chamada Sub Ordenar_Dados(Argumentos).

    Option Explicit
    Dim vTabela_Recap() As Variant

    Sub Distribuir_dados_planilhas()
    Dim Tableau_Recup As Variant

    Dim L As Integer, Item As Integer, vUltimaLinha As Integer, x As Integer
    Dim Col As Byte, vUltimaColuna As Byte
    Dim vNomePlanilha As String
    Dim vColecaoPlanilhas As Collection
    Dim vTabela_Cabecalho(4) As Variant

    vTabela_Cabecalho(0) = "DATA"
    vTabela_Cabecalho(1) = "NOME-SOBRENOME"
    vTabela_Cabecalho(2) = "PLANILHA"
    vTabela_Cabecalho(3) = "PRE-INSRIÇÃO"


    Set vColecaoPlanilhas = New Collection
    x = -1
    With Worksheets("Dados")
    vUltimaLinha = .Range("A65536").End(xlUp).Row
    vUltimaColuna = .Range("IV7").End(xlToLeft).Column
    Tableau_Recup = .Range(.Cells(7, 1), .Cells(vUltimaLinha, vUltimaColuna))
    On Error Resume Next
    For L = 2 To UBound(Tableau_Recup, 1)
    vColecaoPlanilhas.Add Tableau_Recup(L, 3), CStr(Tableau_Recup(L, 3))
    Next
    On Error GoTo 0
    Err.Clear
    End With
    Application.ScreenUpdating = False
    For L = 1 To vColecaoPlanilhas.Count

    vNomePlanilha = vColecaoPlanilhas(L)

    With Worksheets(vNomePlanilha)
    vUltimaLinha = .Range("A65536").End(xlUp).Row + 1
    vUltimaColuna = .Range("IV7").End(xlToLeft).Column
    .Range(.Cells(6, 1), .Cells(vUltimaLinha, vUltimaColuna)).ClearContents
    For Item = 1 To UBound(Tableau_Recup, 1)
    If vColecaoPlanilhas(L) = Tableau_Recup(Item, 3) Then
    x = x + 1
    ReDim Preserve vTabela_Recap(4, x)
    vTabela_Recap(0, x) = Tableau_Recup(Item, 1) 'data
    vTabela_Recap(1, x) = Tableau_Recup(Item, 2) 'nome sobrenome
    vTabela_Recap(2, x) = Tableau_Recup(Item, 3) 'planilha
    vTabela_Recap(3, x) = Tableau_Recup(Item, 4) 'Preinscrição

    End If
    Next

    'chamando a subrotina
    Ordenar_Dados vTabela_Recap

    For Item = 0 To UBound(vTabela_Cabecalho, 1)
    .Cells(1, 1) = "Planilha"
    .Cells(1, 2) = vNomePlanilha
    .Cells(5, 1 + Item) = vTabela_Cabecalho(Item)
    Next
    vUltimaLinha = .Range("A65536").End(xlUp).Row + 1
    .Range("A" & vUltimaLinha).Resize(UBound(vTabela_Recap, 2) + 1, UBound(vTabela_Recap, 1)) = Application.Transpose(vTabela_Recap)

    End With
    Application.ScreenUpdating = True
    x = -1
    vNomePlanilha = ""
    Erase vTabela_Recap
    Next
    MsgBox ("Dados filtrados e separados por ordem com sucesso!!"), vbInformation, "Saberexcel - o site das macros"
    End Sub


    'rotina para ordenar os dados em ordem crescente , é chamada no macro acima : Ordenar_Dados vTabela_Recap
    Sub Ordenar_Dados(ByVal T As Variant)
    Dim Col As Integer, Col2 As Integer
    Dim Tmp1 As Variant, Tmp2 As Variant, Tmp3 As Variant, Tmp4 As Variant
    For Col = 0 To UBound(T, 2)
    For Col2 = 0 To UBound(T, 2)
    If T(0, Col2) > T(0, Col) Then
    Tmp1 = T(0, Col): Tmp2 = T(1, Col): Tmp3 = T(2, Col): Tmp4 = T(3, Col)
    T(0, Col) = T(0, Col2): T(1, Col) = T(1, Col2): T(2, Col) = T(2, Col2): T(3, Col) = T(3, Col2)
    T(0, Col2) = Tmp1: T(1, Col2) = Tmp2: T(2, Col2) = Tmp3: T(3, Col2) = Tmp4
    End If
    Next
    Next
    vTabela_Recap = T
    End Sub



    Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel






    Publicidade
    Compre com segurança, garantia e ótimos preços
    Eletrônicos - Submarino.com.br

    Excel planilha vba autofitro empregados Excel planilha vba autofitro empregados

    popular!
    Adicionado em: 15/05/2011
    Modificado em: 15/05/2011
    Tamanho: 80.69 KB
    Downloads: 937

    Saberexcel - o site de quem precisa Aprender Macros Microsoft Excel VBA.

    E
    ssas códigos(Macros) do Aplicativo Microsoft Excel VBA(Visual Basic Application), filtra determinados dados, e mostra o layout de impressão
    dos dados filtrados, observe que fiz vários macros para cada critério, mas isso poderia ser bem mais simples, se voce indicasse um valor de uma célula.

    Sub Filtrando_Funcionarios_senhores()
    Sheets("Funcionários").Select
    Selection.AutoFilter Field:=2, Criteria1:="Senhor"
    ActiveWindow.SelectedSheets.PrintPreview
    Selection.AutoFilter Field:=2
    ActiveWindow.SelectedSheets.PrintPreview
    Selection.AutoFilter Field:=2
    Sheets("Principal").Select
    End Sub

    Sub Filtrando_Funcionarios_senhoras()
    Sheets("Funcionários").Select
    Selection.AutoFilter Field:=2, Criteria1:="Senhora"
    ActiveWindow.SelectedSheets.PrintPreview
    Selection.AutoFilter Field:=2
    ActiveWindow.SelectedSheets.PrintPreview
    Selection.AutoFilter Field:=2
    Sheets("Principal").Select
    End Sub

    Sub Filtrando_Funcionarios_senhoritas()
    Sheets("Funcionários").Select
    Selection.AutoFilter Field:=2, Criteria1:="Senhorita"
    ActiveWindow.SelectedSheets.PrintPreview
    Selection.AutoFilter Field:=2
    ActiveWindow.SelectedSheets.PrintPreview
    Selection.AutoFilter Field:=2
    Sheets("Principal").Select
    End Sub

    Sub Filtrando_Jardineiro()
    'função do funcionário na empresa.
    Dim vFUNCAO As String
    Application.ScreenUpdating = False
    Sheets("Funcionários").Select
    vFUNCAO = InputBox(prompt:="Digite um critério para Funções", _
    Title:="Saberexcel - Filtrando Funcionarios", Default:="Jardineiro")
    If vFUNCAO = ("") Then Exit Sub 'caso seja anulada a busca na inputbox
    Selection.AutoFilter Field:=5, Criteria1:=vFUNCAO
    ActiveWindow.SelectedSheets.PrintPreview
    Selection.AutoFilter Field:=5
    Sheets("Principal").Select
    Application.ScreenUpdating = True

    End Sub

    Sub Filtrando_Motorista()
    'função do funcionário na empresa.
    Dim vFUNCAO As String
    Application.ScreenUpdating = False
    Sheets("Funcionários").Select
    vFUNCAO = InputBox(prompt:="Digite um critério", _
    Title:="Saberexcel - Filtrando Funcionarios", Default:="Motorista")
    If vFUNCAO = ("") Then Exit Sub 'caso seja anulada a busca na inputbox
    Selection.AutoFilter Field:=5, Criteria1:=vFUNCAO
    ActiveWindow.SelectedSheets.PrintPreview
    Selection.AutoFilter Field:=5
    Sheets("Principal").Select
    Application.ScreenUpdating = True

    End Sub



    Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel




    Publicidade
    Compre com segurança, garantia e ótimos preços
    Eletrônicos - Submarino.com.br

    Excel vba autofiltro transfere determinados dados outra plan Excel vba autofiltro transfere determinados dados outra plan

    popular!
    Adicionado em: 01/01/2011
    Modificado em: 01/01/2011
    Tamanho: 24.95 KB
    Downloads: 926

    Saberexcel - site das macros
    Esta Macro do Aplicativo Microsoft Excel VBA, separa determinados dados e transfere para outra planilha

    Option Explicit

    Sub Transfere_Transforma_Dados()
    Dim vLivro As Workbook
    Dim vPlanDados As Worksheet, vPlanAuxiliar As Worksheet
    Dim vRangeUnica As Range, vRangeInicial As Range, rnData As Range
    Dim rnFilter As Range, rnFind As Range, rnSource As Range
    Dim vaField As Variant
    Dim i As Long, j As Long

    Set vLivro = ThisWorkbook

    With vLivro
    Set vPlanDados = .Worksheets("Pagamento")
    Set vPlanAuxiliar = .Worksheets("Auxiliar")
    End With

    With vPlanDados
    Set vRangeUnica = .Range(.Range("C1"), .Range("C65536").End(xlUp))
    Set rnSource = .Range(.Range("C2"), .Range("C65536").End(xlUp))
    Set rnFilter = .Range(.Range("A1"), .Range("D65536").End(xlUp))
    Set rnData = .Range("A1")
    End With

    With vPlanAuxiliar
    Set vRangeInicial = .Range("A1")
    End With

    Application.ScreenUpdating = False

    'First we sort the table.
    rnFilter.Sort Key1:=Range("C2"), _
    Order1:=xlAscending, _
    Header:=xlGuess, _
    Ordercustom:=1, _
    MatchCase:=True, _
    Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    ' Then we create the unique collection of fieldnames.
    vRangeUnica.AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=vRangeUnica, _
    CopyToRange:=Range("J1"), _
    Unique:=True

    'Read the unique collection into an array.
    With vPlanDados
    vaField = .Range(.Range("J2"), .Range("J65536").End(xlUp))
    End With

    With vRangeInicial
    .Value = "Request_ID"
    'Add the collection to the first row in the target-worksheet.
    .Offset(0, 1).Resize(1, UBound(vaField)).Value = Application.Transpose(vaField)
    'Add the Request-ID numbers to the first column in the target-worksheet.
    .Offset(1, 0).Resize(vRangeUnica.Rows.Count, 1).Value = vRangeUnica.Offset(1, -2).Value
    End With

    'Loop through the collection, set the condition and finally
    'transfer the data into the target-worksheet.


    For i = 1 To UBound(vaField)
    rnData.AutoFilter Field:=3, Criteria1:=vaField(i, 1)
    Set rnFind = rnSource.SpecialCells(xlCellTypeVisible)
    j = rnFind.Rows.Count
    vRangeInicial.Offset(1, i).Resize(j, 1).Value = rnFind.Offset(0, 1).Value
    Next i

    vPlanDados.AutoFilterMode = False

    Application.ScreenUpdating = False

    MsgBox "Concluido"

    End Sub



    Aprenda tudo sobre o Aplicativo Microsoft Excel VBA, sozinho, praticando com os produtos didáticos Saberexcel



    vba autofiltro colorir cabecalho celula com filtro vba autofiltro colorir cabecalho celula com filtro

    popular!
    Adicionado em: 17/11/2010
    Modificado em: 17/11/2010
    Tamanho: 24.98 KB
    Downloads: 685

    Esse procedimento do Aplicativo Microsoft Excel VBA, insere cor no cabeçalho da tabela onde é aplicado o autofiltro, com auxilio de combobox com cores relacionadas.

    Option Explicit

    Private Sub Worksheet_Calculate()
    Dim sb As AutoFilter
    Dim vFiltro As Filter
    Dim vFiltroContador As Integer

    If ActiveSheet.AutoFilterMode Then
    Set sb = ActiveSheet.AutoFilter
    vFiltroContador = 1
    For Each vFiltro In sb.Filters
    If vFiltro.On Then
    sb.Range.Cells(1, vFiltroContador) _
    .Interior.ColorIndex = Range("color")

    Else
    sb.Range.Cells(1, vFiltroContador) _
    .Interior.ColorIndex = xlNone
    End If
    vFiltroContador = vFiltroContador + 1
    Next vFiltro
    Else
    Rows(1).EntireRow.Interior.ColorIndex = xlNone
    End If
    End Sub


    Aprenda tudo sobre o Aplicativo Microsoft Excel VBA - com Saberexcel


    vba autofiltro funcao retorna a cor da fonte vba autofiltro funcao retorna a cor da fonte

    popular!
    Adicionado em: 17/11/2010
    Modificado em: 17/11/2010
    Tamanho: 53.5 KB
    Downloads: 859

    SaberExcel - o site das macros
    Este exemplo de Funções do Aplicativo Microsoft Excel VBA, filtra dados pela cor e Estilo da Fonte. (Cor e Negrito)
    ,
    Observe as Funções

    =Filtra_Txt_Cores(A2) =(as cores abaixo)

    Function Filtra_Txt_Cores(sb As Range)
    Application.Volatile
    Select Case sb.Font.ColorIndex
    Case 3
    Filtra_Txt_Cores = "Vermelho"
    Case 4
    Filtra_Txt_Cores = "Verde"
    Case 1
    Filtra_Txt_Cores = "Preto"
    Case 2
    Filtra_Txt_Cores = "Branco"
    Case Else
    Filtra_Txt_Cores = "outras cores"
    End Select
    End Function

    Essa função retorna se a fonte esta normal ou negritada.
    =Negrito(C12)

    Function Negrito(sb As Range)
    Application.Volatile
    Negrito = IIf(sb.Font.Bold, "Negrito", "Normal")
    End Function


    Aprenda Microsoft Excel VBA -- com Saberexcel
    sozinho, em casa, com baixo custo,





    Página 1 de 2

    Pesquisa Google SaberExcel

    Publicidade Google

    Publicidade

    Rastreamento Correios

    Digite o número do SEDEX conforme o exemplo:
    Correios do Brasil

    Assinatura SaberExcel

    Google Associados

    Depoimentos

    Visitantes SaberExcel

    Excel VBA Estudos®
    mod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_counter
    mod_vvisit_counterHoje575
    mod_vvisit_counterOntem4490
    mod_vvisit_counterEsta Semana22729
    mod_vvisit_counterSemana passada35158
    mod_vvisit_counterEsse mês103963
    mod_vvisit_counterMês passado133216
    mod_vvisit_counterTodos10807274
    Aprenda MS Excel VBA

    Adicione Saberexcel Favoritos

     
     

    Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

    Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel,


       Sobre as WorksheetFunctions Funções de Planilhas que retornam valores do VBA