Guru do Excel e Power BI

Fórum de Dúvidas sobre Excel e Power BI
https://gurudoexcel.com/

Cadastro Veículos para Limpeza Diária

https://gurudoexcel.com/viewtopic.php?t=729

Página 2 de 2

Cadastro Veículos para Limpeza Diária

Enviado: 15 Out 2015 às 10:02
por anacletotranstusa
Alexandre,
Bom dia!
Anexo o modelo que estou tentando aplicar, perceba que simulei vários cadastros do carro 991, ao ser transferido, os valores dos campos "Classificação" e "Data" estão como formulas. Tem como resolver isso? Referente ao erro de execução teria, teria alguma alternativa para evitá-lo? :? :?
Desde já agradeço seus auxilio.

Re: Cadastro Veículos para Limpeza Diária

Enviado: 15 Out 2015 às 10:31
por alexandrevba
Bom dia!!

Tente algo assim.
Código: Selecionar todos
Sub AleVBA_729V3()
Dim LR As Long
Dim SearchRange As Range
Dim FindRow As Range
Application.ScreenUpdating = 0
    LR = Range("B" & Rows.Count).End(xlUp).Row
    With Worksheets("Cadastro")
        With Range("I2:I326")
            .Formula = "=IF(COUNTA(A2:H2)=8,1,IF(AND(B2<>"""",C2<>"""",E2<>"""",OR(F2="""",G2="""",H2="""")),""Erro"",0))"
            .Value = .Value
        End With
        
        .Activate
        .AutoFilterMode = False
        .Range("I2").AutoFilter
        .Range("I2").AutoFilter Field:=9, Criteria1:="#N/D"
        If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count >= 1 Then
            MsgBox "Favor preencher os campos!"
            .AutoFilterMode = False
             Exit Sub
        End If

        If WorksheetFunction.Sum(Range("I2:I" & LR)) = 0 Or WorksheetFunction.CountIf(Range("I2:I" & LR), "Erro") = 1 Then
            Set SearchRange = Range("I2:I326")
            Set FindRow = SearchRange.Find("Erro", LookIn:=xlValues, lookat:=xlWhole)
            MsgBox "favor preencher os campos necessários!" & " Há " & FindRow.Row - 1 & " registro(s) para verificar"
            Exit Sub
        Else
            .Range("$A$1:$I" & LR).AutoFilter Field:=9, Criteria1:="1"
            .Range("A2:H" & LR).Copy Worksheets("Dados").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            .ShowAllData
            '.Range("I2:I326").Value = ""
        End If
    End With
    Worksheets("Dados").Activate
    With Worksheets("Dados")
     'Dim Lastrow As Long
        LR = Range("B" & Rows.Count).End(xlUp).Row
        Range("A2:A" & LR).Formula = "=ROW()-1"
    End With
    Worksheets("Cadastro").Select
    'Call Limpar
    Application.ScreenUpdating = 1
End Sub
Att

Cadastro Veículos para Limpeza Diária

Enviado: 15 Out 2015 às 11:22
por anacletotranstusa
Bom dia Alexandre,

Alterei o código do botão conforme seu auxilio, com a alteração, agora mesmo que informe uma informação de limpeza completa, me apresenta a mensagem "Favor preencher os campos!". Exemplo anexo.
Grato pela atenção.

Re: Cadastro Veículos para Limpeza Diária

Enviado: 15 Out 2015 às 13:07
por alexandrevba
Boa tarde!!

Veja se ajuda.
Código: Selecionar todos
Sub AleVBA_729V4()
Dim LR As Long
Dim SearchRange As Range
Dim FindRow As Range
Application.ScreenUpdating = 0
    LR = Range("B" & Rows.Count).End(xlUp).Row
    With Worksheets("Cadastro")
        With Range("I2:I326")
            .Formula = "=IFERROR(IF(COUNTA(A2:H2)=8,1,IF(AND(B2<>"""",C2<>"""",E2<>"""",OR(F2="""",G2="""",H2="""")),""Erro"",0)),""Erro"")"
            .Value = .Value
        End With

        If WorksheetFunction.Sum(Range("I2:I" & LR)) = 0 Or WorksheetFunction.CountIf(Range("I2:I" & LR), "Erro") = 1 Then
            Set SearchRange = Range("I2:I326")
            Set FindRow = SearchRange.Find("Erro", LookIn:=xlValues, lookat:=xlWhole)
            MsgBox "favor preencher os campos necessários!" & " Há " & FindRow.Row - 1 & " registro(s) para verificar"
            Exit Sub
        Else
            .Range("$A$1:$I" & LR).AutoFilter Field:=9, Criteria1:="1"
            .Range("A2:H" & LR).Copy Worksheets("Dados").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            .ShowAllData
            '.Range("I2:I326").Value = ""
        End If
    End With
    Worksheets("Dados").Activate
    With Worksheets("Dados")
     'Dim Lastrow As Long
        LR = Range("B" & Rows.Count).End(xlUp).Row
        Range("A2:A" & LR).Formula = "=ROW()-1"
    End With
    Worksheets("Cadastro").Select
    'Call Limpar
    Application.ScreenUpdating = 1
End Sub
Att

Cadastro Veículos para Limpeza Diária

Enviado: 15 Out 2015 às 14:06
por anacletotranstusa
Boa Tarde Alexandre,
Editei o código como postado, se deixar sem informação preenchida na aba cadastro e clicar no botão cadastrar ainda apresenta erro "Erro em tempo de execução '91': A variavel do objeto ou variável do bloco 'With' não foi definida.
Outro detalhe: Na aba Dados, perceba que as informações transferidas que contem formulas está sendo transferida com as formulas, observe a coluna "C" (Classificação) e "D" (Data) da aba Dados.
Att.

Re: Cadastro Veículos para Limpeza Diária

Enviado: 15 Out 2015 às 14:14
por alexandrevba
Boa tarde!!

Mas eu fiz o que pediu os detalhes é questão de adaptar!
Código: Selecionar todos
Sub AleVBA_729V4()
Dim LR As Long
Dim SearchRange As Range
Dim FindRow As Range
Application.ScreenUpdating = 0
    LR = Range("B" & Rows.Count).End(xlUp).Row
    With Worksheets("Cadastro")
        With Range("I2:I326")
            .Formula = "=IFERROR(IF(COUNTA(A2:H2)=8,1,IF(AND(B2<>"""",C2<>"""",E2<>"""",OR(F2="""",G2="""",H2="""")),""Erro"",0)),""Erro"")"
            .Value = .Value
        End With

        If WorksheetFunction.Sum(Range("I2:I" & LR)) = 0 Or WorksheetFunction.CountIf(Range("I2:I" & LR), "Erro") = 1 Then
            Set SearchRange = Range("I2:I326")
            Set FindRow = SearchRange.Find("Erro", LookIn:=xlValues, lookat:=xlWhole)
            MsgBox "favor preencher os campos necessários!" & " Há " & FindRow.Row - 1 & " registro(s) para verificar"
            Exit Sub
        Else
            .Range("$A$1:$I" & LR).AutoFilter Field:=9, Criteria1:="1"
            .Range("A2:H" & LR).Copy Worksheets("Dados").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            .ShowAllData
            '.Range("I2:I326").Value = ""
        End If
    End With
    Worksheets("Dados").Activate
    With Worksheets("Dados")
     'Dim Lastrow As Long
        LR = Range("B" & Rows.Count).End(xlUp).Row
        Range("A2:A" & LR).Formula = "=ROW()-1"
    End With
    Worksheets("Cadastro").Select
    'Call Limpar
    Application.ScreenUpdating = 1
End Sub
Editado, favor verificar o código!!!
Att

Cadastro Veículos para Limpeza Diária

Enviado: 15 Out 2015 às 14:33
por anacletotranstusa
:) :) Creio que você se equivoco no poste. O poste do Filtro já está resolvido.

Re: Cadastro Veículos para Limpeza Diária

Enviado: 15 Out 2015 às 16:57
por alexandrevba
Boa tarde!!

Altere a linha para:
Código: Selecionar todos
        With Range("I2:I326")
            .Formula = "=IFERROR(IF(COUNTA(A2:H2)=8,1,IF(AND(COUNTA(A2:H2)=0,OR(F2="""",G2="""",H2="""")),""Erro"",""Erro"")),""Erro"")"
            .Value = .Value
        End With

        If WorksheetFunction.Sum(Range("I2:I" & LR)) = 0 Or WorksheetFunction.CountIf(Range("I2:I" & LR), "Erro") > 1 Then
Faça os testes.

Att

Cadastro Veículos para Limpeza Diária

Enviado: 15 Out 2015 às 17:34
por anacletotranstusa
Alterei o código e veja como ficou, agora, quando informado as informações necessário para um registro apresenta a mensagem "Favor preencher os campos necessário! Há 2 Registro(s) para verificar". Em relação a transferência, teria alguma solução para transferi somente os valores.

Re: Cadastro Veículos para Limpeza Diária

Enviado: 16 Out 2015 às 13:06
por lfgomes
Boa tarde amigo...

Com base na sua Planilha, fiz uma com a visualização mais limpa e um código mais simples para realizar o cadastro...

Veja se assim pode te ajudar...

Imagem

Cadastro Veículos para Limpeza Diária

Enviado: 16 Out 2015 às 15:41
por anacletotranstusa
Boa Tarde lfgomes,
Ficou show de bola.
Porem, na aba Cadastro preciso que conste todos os carros a ser limpo, visto que em média são registrado 160 limpezas de carros, ou seja, nesse caso seria 160 registro um de cada vez. Devido a isso, ficaria mais rápido o cadastro se fosse possível informar somente os veículos limpos e depois clicar no botão cadastrar fazendo a transferência somente dos veículos limpos. Teria como fazer? :roll: :roll: , cara, muito obrigado pela sua diga, tem como você me auxiliar no desenvolvimento conforme já descrevi acima?

Re: Cadastro Veículos para Limpeza Diária

Enviado: 20 Out 2015 às 15:46
por lfgomes
Boa tarde amigo...

Veja se agora atende ao que você precisa...

Imagem

Re: Cadastro Veículos para Limpeza Diária

Enviado: 21 Out 2015 às 08:20
por lfgomes
Bom dia...

Estive trabalhando um pouco mais nessa Planilha e acho que consegui melhora-la um pouquinho mais...

Teste as duas e veja se alguma lhe serve...

Abraço...

Imagem

Re: Cadastro Veículos para Limpeza Diária

Enviado: 21 Out 2015 às 09:43
por anacletotranstusa
Bom dia lfgomes,
Muito obrigado ficou show de bola, as duas opções já me atenderia.
A segunda opção ficou melhor, estarei implantando, porem, preciso incluir uma formula no campo Data e algumas validações de dados nos campos: Colaborador, Tipo_Lavação, Turno, Responsável, evitando que o usuário informe dados erroneamente (Modelo Anexo), quando clicado no botão cadastrar faz a transferências para a "aba Dados" com a informação do campo data como formula e todos os campos com validação de dado também é transferido com a validação de dados, precisaria que seja transferido somente os valores.
Cara, se puder me auxiliar estaria concluindo a planilha perfeita para minha necessidade.
Cara, agradeço muito sua atenção. ;)

Re: Cadastro Veículos para Limpeza Diária

Enviado: 21 Out 2015 às 10:45
por lfgomes
Bom dia...

Veja se agora está funcionando do jeito que você quer...

Imagem

Cadastro Veículos para Limpeza Diária

Enviado: 21 Out 2015 às 13:43
por anacletotranstusa
Muito bom! :D
Só para encerrar, preciso também limpar a informação da Célula "L1", sei que é no código abaixo, porem não consegui.
Range("D2:G" & Range("I1").Value).Select
Selection.ClearContents

Re: Cadastro Veículos para Limpeza Diária

Enviado: 21 Out 2015 às 14:01
por lfgomes
Prontinho...

Terminado...

Espero que esteja do jeito que você quer...

Imagem

Cadastro Veículos para Limpeza Diária

Enviado: 21 Out 2015 às 14:27
por anacletotranstusa
Resolvido!!!Maravilha! Agradeço muito ...muito mesmo, a você, ao Alexandre e Henrique, que de alguma maneira tentaram me auxiliar no desenvolvimento desta planilha. Fico sem palavra para demonstrar minha gratidão.
Abraço! :D
Todos os horários são UTC-03:00
Página 2 de 2
Powered by phpBB® Forum Software © phpBB Limited