Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Verificação AutoFil...
 
Notifications
Clear all

Verificação AutoFilter

 
2024 - VBA & Macros
Post Recente por Osvaldomp 7 anos atrás
7 Posts
3 Usuários
0 Reactions
1,293 Visualizações
RSS
 gsinhorini
(@gsinhorini)
Posts: 3
New Member
Topic starter
 

Olá Muito bom dia!
Sou novo com vba, comecei não tem 2 meses. Estou desenvolvendo uma planilha totalmente mecanizada onde o usuário clica nos botões e executa os procedimentos.
Eu estou com um problema, estou fazendo um filtro para procurar alguns pedidos que estão com o status executados, nessa parte está tudo certo o problema é quando o filtro retorna em branco, eu preciso avisar ao usuario que não existe pedidos executado. Já tentei varia coisas mas nada deu certo, será que alguém pode me ajudar?
Abaixa é o código que estou utilizando.

ActiveSheet.Range("$C$1:$BK" & UltimaLinhaBD).AutoFilter Field:=61, Criteria1:="SERVIÇO EXECUTADO"
    
    If Not ActiveSheet.Range("$C$1:$BK$" & UltimaLinhaBD).AutoFilter(Field:=61, Criteria1:="SERVIÇO EXECUTADO") = True Then
        MsgBox "Não Existe Peido em Execução"
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
        Sheets("Pedidos_Executados").Select
    Else

Muito obrigado pela ajuda.

Atenciosamente
Guilherme Sinhorini

 
Postado : 01/08/2017 6:27 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Guilherme,

Poste seu arquivo.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 01/08/2017 6:31 am
 gsinhorini
(@gsinhorini)
Posts: 3
New Member
Topic starter
 

Guilherme,

Poste seu arquivo.

Olá Wagner, muito bom dia!

Sub PesquisarPedidoExecutado()
    Dim ultimalinha1 As Integer
    
    Sheets("BD_Pedidos").Select
    
    For linha = 2 To 3000
        If Sheets("BD_Pedidos").Cells(linha, 3) = "" Then
            UltimaLinhaBD = linha - 1
            Exit For
        End If
    Next
    
    If ActiveSheet.Range("$C$1:$BK" & UltimaLinhaBD).AutoFilter(Field:=61, Criteria1:="SERVIÇO EXECUTADO") = True Then
    ActiveSheet.autifilter.Range.Offset(1).SpecialCells(x1celltyprvisible).Cells(1, 1).Select

    Range("$C$1:$BK" & UltimaLinhaBD).Select
    Selection.Copy
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Sheets.Add.Name = "Temp"
    'Sheets("Temp").Select
    Range("A1").Select
    ActiveSheet.Paste

    Sheets("Temp").Activate
        LastRowPedidos_Executados = Cells(Rows.Count, "C").End(xlUp).Row
    Range("A1:A" & LastRowPedidos_Executados).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BQ1"), Unique:=True
    Range("Z1:Z" & LastRowPedidos_Executados).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BR1"), Unique:=True
    Range("AE1:AE" & LastRowPedidos_Executados).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BS1"), Unique:=True
    UltLinhaNumPedido = Cells(Rows.Count, "BQ").End(xlUp).Row
    UltLinhaBloco = Cells(Rows.Count, "BR").End(xlUp).Row
    UltLinhaOperacao = Cells(Rows.Count, "BS").End(xlUp).Row
    PrimLinhaResumo = Cells(Rows.Count, "A").End(xlUp).Row + 3
    Set RngNumPedido = Range("BQ2:BQ2").Resize(UltLinhaBloco - 1).SpecialCells(xlCellTypeVisible)
    RngNumPedido.Select
    Set RngBloco = Range("BR2:BR2").Resize(UltLinhaBloco - 1).SpecialCells(xlCellTypeVisible)
    RngBloco.Select
    Set RngOperacao = Range("BS2:BS2").Resize(UltLinhaOperacao - 1).SpecialCells(xlCellTypeVisible)
    RngOperacao.Select
    Contador = 0
    For Each a In RngNumPedido
    For Each b In RngBloco
        For Each c In RngOperacao
            With ActiveSheet.Range("A:BI")
                .AutoFilter Field:=1, Criteria1:=a.Value
                .AutoFilter Field:=26, Criteria1:=b.Value
                .AutoFilter Field:=31, Criteria1:=c.Value

                ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
            End With
                If Not IsEmpty(ActiveCell.Value) Then
                    Cells(PrimLinhaResumo + Contador, "A") = ActiveCell.Offset(0, 0).Value
                    Cells(PrimLinhaResumo + Contador, "B") = ActiveCell.Offset(0, 2).Value
                    Cells(PrimLinhaResumo + Contador, "C") = ActiveCell.Offset(0, 4).Value
                    Cells(PrimLinhaResumo + Contador, "D") = ActiveCell.Offset(0, 7).Value
                    Cells(PrimLinhaResumo + Contador, "E") = ActiveCell.Offset(0, 13).Value
                    Cells(PrimLinhaResumo + Contador, "F") = ActiveCell.Offset(0, 14).Value
                    Cells(PrimLinhaResumo + Contador, "G") = ActiveCell.Offset(0, 25).Value
                    Cells(PrimLinhaResumo + Contador, "H") = ActiveCell.Offset(0, 28).Value
                    Cells(PrimLinhaResumo + Contador, "I") = ActiveCell.Offset(0, 29).Value
                    Cells(PrimLinhaResumo + Contador, "J") = ActiveCell.Offset(0, 30).Value
                    Cells(PrimLinhaResumo + Contador, "K") = ActiveCell.Offset(0, 31).Value
                    Cells(PrimLinhaResumo + Contador, "L") = ActiveCell.Offset(0, 33).Value
                    Cells(PrimLinhaResumo + Contador, "M") = ActiveCell.Offset(0, 34).Value
                    Cells(PrimLinhaResumo + Contador, "N") = ActiveCell.Offset(0, 35).Value
                    Cells(PrimLinhaResumo + Contador, "O") = ActiveCell.Offset(0, 36).Value
                    Cells(PrimLinhaResumo + Contador, "P") = ActiveCell.Offset(0, 37).Value
                    Cells(PrimLinhaResumo + Contador, "Q") = ActiveCell.Offset(0, 41).Value
                    Cells(PrimLinhaResumo + Contador, "R") = ActiveCell.Offset(0, 42).Value
                    Cells(PrimLinhaResumo + Contador, "S") = ActiveCell.Offset(0, 43).Value
                    Cells(PrimLinhaResumo + Contador, "T") = ActiveCell.Offset(0, 47).Value
                    Cells(PrimLinhaResumo + Contador, "U") = ActiveCell.Offset(0, 48).Value
                    Cells(PrimLinhaResumo + Contador, "V") = ActiveCell.Offset(0, 49).Value
                    Cells(PrimLinhaResumo + Contador, "W") = ActiveCell.Offset(0, 50).Value
                    Cells(PrimLinhaResumo + Contador, "X") = ActiveCell.Offset(0, 51).Value
                    Cells(PrimLinhaResumo + Contador, "Y") = ActiveCell.Offset(0, 52).Value
                    Cells(PrimLinhaResumo + Contador, "Z") = ActiveCell.Offset(0, 53).Value
                    Cells(PrimLinhaResumo + Contador, "AA") = ActiveCell.Offset(0, 54).Value
                    Cells(PrimLinhaResumo + Contador, "AB") = ActiveCell.Offset(0, 55).Value
                    Cells(PrimLinhaResumo + Contador, "AC") = ActiveCell.Offset(0, 60).Value
    
                    Contador = Contador + 1
                End If
            Next
        Next
    Next
    'UltimaLinhaResumo = Range("A" & PrimLinhaResumo).CurrentRegion.Rows.Count
    For linha = PrimLinhaResumo To 3000
        If Sheets("Temp").Cells(linha, 1) = "" Then
            UltimaLinhaResumo = linha - 1
            Exit For
        End If
    Next
    Range("A" & CStr(PrimLinhaResumo) & ":AC" & CStr(UltimaLinhaResumo)).Select
    Selection.Copy
    Sheets("Pedidos_Executados").Select
    For linha1 = 2 To 3000
        If Sheets("Pedidos_Executados").Cells(linha1, 3) = "" Then
            ultimalinha1 = linha1
            Exit For
        End If
    Next
    Range("C" & CStr(ultimalinha1)).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
    'Sheets("Temp").Select
    Application.DisplayAlerts = False
    Sheets("Temp").Delete
    Application.DisplayAlerts = True
    
    
    'If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Else
        MsgBox "Não Existe Peido em Execução"
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
        Sheets("Pedidos_Executados").Select
    End If
End Sub

Essa é todo o codigo.

 
Postado : 01/08/2017 7:09 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Guilherme,

O arquivo. Não o código.

Se não puder postar o arquivo porque os dados são confidenciais, basta descaracterizar os dados confidenciais.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 01/08/2017 8:37 am
 gsinhorini
(@gsinhorini)
Posts: 3
New Member
Topic starter
 

Olá
https://1drv.ms/x/s!AreyOiP-W0_ohxKGS5-x2XXJIX0W

Link para downloads

 
Postado : 01/08/2017 8:52 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

gsinhorini,

Você deve anexar seu arquivo, compactado com .ZIP, aqui mesmo no fórum. Logo abaixo da caixa de mensagem existem abas destinadas a esse fim. A postagem através de links muito vezes é bloqueada na maioria das empresas. Eu, por exemplo, não consigo acessar arquivos postados através de links.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 01/08/2017 9:04 am
 Osvaldomp
(@osvaldomp)
Posts: 0
Eminent Member
 

... MsgBox "Não Existe Peido em Execução" ...

dica - se a situação descrita acima se alterar e provocar riscos ~~~> SAMU-192 e RESGATE-193 ;)

Osvaldo

 
Postado : 01/08/2017 10:27 am
Forum Jump:
  Tópico Anterior
Próximo Tópico