Este fórum está sendo desativado

[anacletotranstusa]

Bom dia,
Foi criado um tópico anterior porem marquei como resolvido por engano, por esse motivo estou abrindo este tópico para resolver meu problema. Modelo anexo.
Preciso criar um rotina que impeça o usuário a cadastra as informações quando não informadas.
Exemplo: nesta pasta de trabalho possui a aba cadastro, nela contem todos os veículos a disposição para realizar a limpeza diária, porem não é necessário limpar todos os veículos diariamente, ou seja, conforme a disponibilidade do veiculo parado no pátio é realizado a limpeza, ao informado o nome do Colaborador o campo data possui um formula que puxa a data do dia, sendo assim. Farei uma Representação de cadastro para um melhor intendimento: Carro: 991; Classificação: Articulado; Data: 07/10/2015; Colaborador: Adriano; Tipo_Lavação: Limpeza Geral interna Articulado; Turno: ????; Responsável: ???. Outro cadastro: Carro: 212; Classificação: Articulado; Data: 07/10/2015; Colaborador: Adriano; Tipo_Lavação:???; Turno: ????; Responsável: Pedro. Faltou informações nas duas situações, se o usuário clicar no botão cadastro, retornará a mensagem, favor preencher todos os campos necessários, não permitindo a transferência das informações para aba Dados até que seja informado todos os campos não informados.
Desde já agradeço atenção.

[Henrique]

Anacleto,

Segue com a correção que necessita.

Abraço

[alexandrevba]

Boa tarde!!

faça os testes!

Código: Selecionar todos

Sub AleVBA_729()
Dim LR As Long
Dim SearchRange As Range
Dim FindRow As Range

    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<>"""",H2<>"""",OR(F2="""",G2="""")),""Favor preencher os campos [Turno - Lavação]"",0))"
            .Value = .Value
        End With
        If WorksheetFunction.Sum(Range("I2:I" & LR)) = 0 Or WorksheetFunction.CountIf(Range("I2:I" & LR), "Favor preencher os campos [Turno - Lavação]") = 1 Then
            Set SearchRange = Range("I2:I326")
            Set FindRow = SearchRange.Find("Favor preencher os campos [Turno - Lavação]", 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
'use sua macro limpeza
'Call Limpeza
End Sub

Att

[anacletotranstusa]

Boa Tarde Henrique,
No exemplo que posto ao clicar no botão cadastrar é finalizado mesmo que esteja faltando informações. Simulei um cadastro incluindo um nome as demais informações não foi informada, cliquei no botão cadastrar a macro finalizou, mas não transferiu a informação, preciso que me apresente um mensagem que está faltando informações até a informação seja inserida, caso contrário não permitira concluir o cadastro.
Alexandre, boa tarde,
Em seu código gerou um erro:

Código: Selecionar todos

 Sub AleVBA_729()
Dim LR As Long
Dim SearchRange As Range
Dim FindRow As Range

    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<>"""",H2<>"""",OR(F2="""",G2="""")),""Favor preencher os campos [Turno - Lavação]"",0))"
            .Value = .Value
        End With
        If WorksheetFunction.Sum(Range("I2:I" & LR)) = 0 Or WorksheetFunction.CountIf(Range("I2:I" & LR), "Favor preencher os campos [Turno - Lavação]") = 1 Then
            Set SearchRange = Range("I2:I326")
            Set FindRow = SearchRange.Find("Favor preencher os campos [Turno - Lavação]", LookIn:=xlValues, lookat:=xlWhole)
           [u][i] MsgBox "favor preencher os campos necessários!" & " Há " & FindRow.Row - 1 & " registro(s) para verificar"[/i][/u]
            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
'use sua macro limpeza
'Call Limpeza
End Sub

Desde já agradeço atenção de ambos colegas!
Abraço!

[alexandrevba]

Boa tarde!!

Reveja a referencias de objeto, pois eu não tive erro!!

Qual o erro, qual linha?

Att

[anacletotranstusa]

Erro em tempo de Execução '91':
A variável do objeto ou variável do bloco 'With' não foi definida.
na linha:
MsgBox "favor preencher os campos necessários!" & " Há " & FindRow.Row - 1 & " registro(s) para verificar"

[alexandrevba]

Boa tarde!!

Eu não tive o erro, favor executar a macro baseado no anexo!



Attt

[anacletotranstusa]

Boa Tarde!!
Desta vez não gero o erro! Porem não atende minha necessidade.
Faz o teste ai,
Simule três cadastros, dois com todos os campos informados e um cadastro deixe faltando a informação do responsável em branco, ao clicar no botão cadastrar, deveria bloquear, não permitindo a transferência das informações para a aba Dados até que o usuário informe o campo em branco que neste caso é o do responsável.
Desde já agradeço sua atenção.

[Henrique]

Anacleto,

A versão da planilha que criei para você não cadastra os campos que não estiverem 100% preenchidos, entretanto não está avisando o usuário dos registros incompletos. É só fazer uma adaptação da minha planilha com a sugestão do Alexandre.

Abraço

[alexandrevba]

Boa tarde!!

Dados até que o usuário informe o campo em branco que neste caso é o do responsável.

No meu caso, o código não copia os dados e manda uma mensagem, somente se os campos preenchidos estiverem completos.

Eu vou deixar quem entendeu, responder.

Att

[anacletotranstusa]

Tentei fazer as adaptações, como não tenho muita noção e pratica não consegui sucesso! Poderia me auxiliar!

[anacletotranstusa]

Alexandre,
Gostaria de evitar possíveis erros, pois o usuário pode esquecer de informar alguma informação referente ao registro e ao clicar e cadastrar essa informação não será transferida para a base de dados. Desta forma criando de um bloqueio caso esquecer de informar algum dado necessário não permita cadastrar. Digamos que se ele informou o nome do colaborador os demais campos deve ser obrigatórios...

[alexandrevba]

Bom dia!!

Nos testes que eu fiz eu usei uma regra, se os campos das colunas A até F e H estiverem preenchidos mas se o usuário esquecer de preencher o Turno e Lavações então os dados não serão copiados, até que o mesmo complete!!!

Além de disparar uma mensagem deixei propositalmente na coluna I um aviso!

O que mais será necessário ou o que você quer mudar, pois eu não estou entendendo.
Att

[anacletotranstusa]

Alexandre, Bom dia !
Ainda estou quebrando cabeça para tentar encontrar uma logica para não permitir finalizar o cadastro faltando informações necessárias.
Tentei montar essa estrutura, mas está ocorrendo erro. Minha lógica seria: Se na coluna "I" contiver o numero 1, faz a transferência das informações da linha entre "A","B","C","D","E","F","G" e "H", caso contiver o texto "Erro", será apresentado uma mensagem "Está faltando informações necessárias para finalizar o cadastro"
Sub Cadastrar()
Dim i As Long
Dim UltimaLinhaCadastro As Long
Dim UltimaLinhaDados As Long


UltimaLinhaCadastro = Sheets("Cadastro").Cells(Cells.Rows.Count, 1).End(xlUp).Row
UltimaLinhaDados = Sheets("Dados").Cells(Cells.Rows.Count, 1).End(xlUp).Row
If UltimaLinhaDados = 1 Then
Sheets("Dados").Range("A2").Value = 1
End If

If Sheets("Dados").Range("I").Value = "Erro" Then

MsgBox "Está faltando informações necessárias para finalizar o cadastro", vbCritical, "Atenção"
End If


For i = 2 To UltimaLinhaCadastro


If Range("I" & i).Value = 1 Then

If UltimaLinhaDados <> 1 Then
Sheets("Dados").Range("A" & UltimaLinhaDados + 1).Value = Sheets("Dados").Range("A" & UltimaLinhaDados).Value + 1
End If
Sheets("Dados").Range("B" & UltimaLinhaDados + 1).Value = Range("B" & i).Value
Sheets("Dados").Range("C" & UltimaLinhaDados + 1).Value = Range("C" & i).Value
Sheets("Dados").Range("D" & UltimaLinhaDados + 1).Value = Range("D" & i).Value
Sheets("Dados").Range("E" & UltimaLinhaDados + 1).Value = Range("E" & i).Value
Sheets("Dados").Range("F" & UltimaLinhaDados + 1).Value = Range("F" & i).Value
Sheets("Dados").Range("G" & UltimaLinhaDados + 1).Value = Range("G" & i).Value
Sheets("Dados").Range("H" & UltimaLinhaDados + 1).Value = Range("H" & i).Value
UltimaLinhaDados = Sheets("Dados").Cells(Cells.Rows.Count, 1).End(xlUp).Row
End If
Next
Call Limpar


End Sub

[anacletotranstusa]

Esqueci de anexar o modelo!
Desde já agradeço atenção.

[anacletotranstusa]

Boa Tarde Alexandre,
Primeiramente peço desculpas, eu havia me equivocado, a sua planilha ficou show, o bloqueio ficou perfeito.
Único fato que preciso corrigir seria no momento da transferência, na aba Dados, preciso que a coluna "A" fique com os números sequenciais, do jeito que tá, é transferido o numero com base da aba cadastro, ou seja, fique na ordem de 1,2,3,4,5 ..........sucessivamente.
Outro detalhe: Quando é realizado a transferência está transferindo as informações com formulas, tem como só copiar os valores sem as formulas?

Sub AleVBA_729()
Dim LR As Long
Dim SearchRange As Range
Dim FindRow As Range

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
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
'Call Limpar
End Sub

[alexandrevba]

Boa tarde!!

Nos meus teste ao copiar os dados e ir até a guia Dados, ao verificar os dados estão como valores!

Para classificar use o gravador de macros..

Código: Selecionar todos

Sub Macro1()
'
' Macro1 Macro
'

'
    Cells.Select
    ActiveWorkbook.Worksheets("Dados").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Dados").Sort.SortFields.Add Key:=Range("A2:A87"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dados").Sort
        .SetRange Range("A1:H87")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Por favor: Click na mãozinha

Att

[anacletotranstusa]

Obrigado!
Referente a transferência, na verdade não seria uma classificação, digamos que foi limpo três carros, ao transferir para a aba Dados, a coluna "A" seja registrado, 1, 2, 3, no outro dia, foi limpo mais 10 carros, na coluna "A" ficaria 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13.... e sucessivamente.

[alexandrevba]

Boa tarde!!

Seria isso?

Código: Selecionar todos

Sub AleVBA_729V2()
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
        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

[anacletotranstusa]

Perfeito! Mais uma coisa para finalizar, como poderia tratar o erro da macro se caso não tiver nada preenchido, ao clicar no botão cadastrar dá um erro de execução, sabe como é, se o usuário que irá alimentar as informações clicar no botão cadastrar e geral o erro vai se desesperar.
Se puder me auxiliar mais uma vez...Desde já agradeço sua atenção.