Preciso de ajuda para elaborar minha macro

[ad48]

boa noite colegas

não entendo  muito de vba.

 

tenho planilha formulario de digitação.

 

 

uso este ex. de validação se tiver alguma celula em branco no formulario 

não grava o formulario. 

------------------------------------------------------------ 

Sub GRAVAR_FORMUALRIO()

If IsEmpty(Range("FORMULARIO!D2")) Or IsEmpty(Range("FORMULARIO!D4")) Or IsEmpty(Range("FORMULARIO!D6")) Or IsEmpty(Range

 

("FORMULARIO!J6")) Or IsEmpty(Range("FORMULARIO!P6")) Or IsEmpty(Range("FORMULARIO!AA4")) Then

Mensagem = MsgBox("FAVOR VERIFICAR DIA,MES,ANO,SETOR,ZONA E VENDEDOR CÉLULAS EM VERMELHO ESTÃO VAZIAS.GRAVAÇÃO CANCELADA!")

Exit Sub

End If

 

Application.ScreenUpdating = False

Application.Calculate

Sheets("DATA").Visible = True

Sheets("DATA").Select

Range("A2:BW16").Select

Selection.Copy

    Sheets("DATABASE").Visible = True

    Sheets("DATABASE").Select

    If Range("A2").Value = "" Then

       Range("A2").Select

    Else

        ActiveCell.SpecialCells(xlLastCell).Select

        Selection.End(xlDown).Select

        Selection.End(xlToLeft).Select

        Selection.End(xlUp).Select

        ActiveCell.Offset(1, 0).Select

    End If

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

 

MsgBox "Formulario Incluso!"

 

End Sub

-------------------------------------------------------------------------------------------

planilha data que é alimentada do formulario

 

a macro gravar formulario 

copia da planilha data pra planilha DATABASE 

obs sempre deve colar na proxima em branco

ate tudo beleza.

 

o seguinte se ficar rodando a macro vai duplicando as informação.

 

preciso adicionar na macro validação 

coluna BV ValidaDuplicado

se repetir deve fazer uma pergunta

deseja substituir as 15 informações contidas na colunas  A : BW?

sim grava não foi cancelado a gravação.

 

 

muito obrigado.

[ad48]

alguem tem alguma ajuda?

[Visitante]

Confirmando as informações:
1. você vai digitar registros na planilha DATA e utilizar um código (macro) para enviar os registros digitados para a planilha DATABASE ?
(se for isso, porque não digitar diretamente na planilha DATABASE ?)
2. poderá variar a quantidade de registros que serão digitados e enviados da cada vez?
3. os registros que forem repetidos, ou seja, as colunas E, H, I e J repetidas, precisarão de confirmação antes de enviar
4. os registros enviados e os recusados serão apagados ?
 

[ad48]

alguma ajuda?

[ad48]

Boa noite amigo

 

enviei outro anexo com a base formulario

 

pode me dar uma ajuda fico muito agradecido

 

att.

 

[ad48]

Confirmando as informações:

1. você vai digitar registros na planilha DATA e utilizar um código (macro) para enviar os registros digitados para a planilha DATABASE ?

(se for isso, porque não digitar diretamente na planilha DATABASE ?)

2. poderá variar a quantidade de registros que serão digitados e enviados da cada vez?

3. os registros que forem repetidos, ou seja, as colunas E, H, I e J repetidas, precisarão de confirmação antes de enviar

4. os registros enviados e os recusados serão apagados ?

 

boa tarde grande osvaldomp,

 

resposta

1.reformulei o testo e adicionei a base com todas planilha 

é digitado na planilha formulario.

2.a quantidade de registro devera ser sempre a mesma se faltar digitar uma informação deve informar que tem  celula vazia no formulario e não fazer a gravação do mesmo.

3.na coluna BV deve ser feito a ValidaDuplicado não pode repetir ,se repetir fazer uma pergunta deseja substituir as 15 informações 

sim grava não foi cancelado a gravação.

4,os registros enviados devem sempre colar na proxima linha vazia.

 

obrigado.

[Visitante]

Veja se entendi corretamente o que você pretende.

Sugiro que você faça os testes em uma cópia do seu arquivo.

1. instale o código abaixo em um módulo existente ou em um novo módulo.
 

Sub CopiaDATAColaDATABASE()  Dim LRo As Long, LRd As Long, rCod As Range, rFiCod As Range, rData As Range    LRo = Sheets("BASE").Cells(Rows.Count, 1).End(xlUp).Row      For Each rCod In Sheets("BASE").Range("A2:A" & LRo)        LRd = Sheets("DATABASE").Cells(Rows.Count, 1).End(xlUp).Row        Set rFiCod = Sheets("DATABASE").Range("A2:A" & LRd).Find(rCod.Value, lookat:=xlWhole)          If rFiCod Is Nothing Then            Sheets("DATABASE").Range("A" & LRd + 1).Resize(, 75).Value = _               Sheets("BASE").Cells(rCod.Row, 1).Resize(, 75).Value          Else            With Sheets("DATABASE").Range("A1:BW1")              .AutoFilter              .AutoFilter Field:=1, Criteria1:=rCod                For Each rData In .Range("H2:H" & LRd).SpecialCells(xlCellTypeVisible)                  If DateSerial(.Cells(rData.Row, "J"), .Cells(rData.Row, "I"), .Cells(rData.Row, "H")) = _                    DateSerial(Sheets("BASE").Cells(rCod.Row, "J"), Sheets("BASE").Cells(rCod.Row, "I"), _                      Sheets("BASE").Cells(rCod.Row, "H")) Then                        If MsgBox("DESEJA SUBSTITUIR O CÓDIGO  " & rCod & " - " & _                          DateSerial(Sheets("BASE").Cells(rCod.Row, "J"), Sheets("BASE").Cells(rCod.Row, "I"), _                            Sheets("BASE").Cells(rCod.Row, "H")) & " ?", vbYesNo + vbQuestion) = vbYes Then                         .Cells(rFiCod.Row, 1).Resize(, 75).Value = Sheets("BASE").Cells(rCod.Row, 1).Resize(, 75).Value                        Exit For                        Else: Exit For                        End If                  Else: Sheets("DATABASE").Range("A" & LRd + 1).Resize(, 75).Value = _                          Sheets("BASE").Cells(rCod.Row, 1).Resize(, 75).Value                  End If                 Next rData              .AutoFilter            End With          End If      Next rCodEnd Sub

 

 
 
 
2. no código Sub GRAVAR_FORMUALRIO(), já existente, apague todas as linhas localizadas no intervalo informado abaixo, e no lugar das linhas apagadas coloque o nome do novo código.

Está assim:
 

Sub GRAVAR_FORMUALRIO()
...
Application.ScreenUpdating = False
Application.Calculate
...
'apague todas as linhas neste intervalo
...
'CONTA FORMULARIO GRAVADO
ActiveSheet.Unprotect
...
End Sub

 

 

Deverá ficar assim:
 

Sub GRAVAR_FORMUALRIO()
...
Application.ScreenUpdating = False
Application.Calculate
 
CopiaDATAColaDATABASE 'linha nova
 
'CONTA FORMULARIO GRAVADO
ActiveSheet.Unprotect
...
End Sub

 

 

[ad48]

 

boa noite grande osvaldomp,

 

falta pequenos ajustes,

 

a validacao não pode ser feita na coluna BV? valida estado,zona,dia mes ano.

 

a pergunta não ser feita substituir a digitação sim ou não? = para todo formulario digitado?

 

 funcionou legal 

na segunda ele pergunta e faz a substitução,

 

agora no ex: 

database com os dias gravados 3,4 e 5 = 45 codigos ta certo.

 

se rodar a macro novamente o dia 5  apos confirmar pra fazer as  substitução

não funcionou

ficou assim

dia 1 = 1 codigo 

dia 2 = 14 codigos

dia 3 = 45 codigos resumo repetiu 3 vezes cada codigo

 

obrigado.

[Visitante]

 

falta pequenos ajustes,

 

a validacao não pode ser feita na coluna BV? valida estado,zona,dia mes ano.

O código abaixo verifica as colunas "A" e "BV" para identificar se o registro já existe na planilha "DATABASE", ao invés de verificar "A" e a data em "H:J". Coloque-o no lugar do anterior.

 

 

a pergunta não ser feita substituir a digitação sim ou não? = para todo formulario digitado?

Não entendi.

 

 

se rodar a macro novamente o dia 5  apos confirmar pra fazer as  substitução

não funcionou

ficou assim

dia 1 = 1 codigo 

dia 2 = 14 codigos

dia 3 = 45 codigos resumo repetiu 3 vezes cada codigo

Este erro não ocorre nos testes que fiz aqui.

 

 

Sub CopiaDATAColaDATABASE()  Dim LRo As Long, LRd As Long, rCod As Range, rFiCod As Range, rData As Range    LRo = Sheets("BASE").Cells(Rows.Count, 1).End(xlUp).Row      For Each rCod In Sheets("BASE").Range("A2:A" & LRo)        LRd = Sheets("DATABASE").Cells(Rows.Count, 1).End(xlUp).Row        Set rFiCod = Sheets("DATABASE").Range("A2:A" & LRd).Find(rCod.Value, lookat:=xlWhole)          If rFiCod Is Nothing Then            Sheets("DATABASE").Range("A" & LRd + 1).Resize(, 75).Value = _               Sheets("BASE").Cells(rCod.Row, 1).Resize(, 75).Value          Else            With Sheets("DATABASE").Range("A1:BW1")              .AutoFilter              .AutoFilter Field:=1, Criteria1:=rCod                For Each rData In .Range("BV2:BV" & LRd).SpecialCells(xlCellTypeVisible)                  If .Cells(rData.Row, "BV") = Sheets("BASE").Cells(rCod.Row, "BV") Then                    If MsgBox("DESEJA SUBSTITUIR O CÓDIGO  " & rCod & " - " & _                      Sheets("BASE").Cells(rCod.Row, "BV") & " ?", vbYesNo + vbQuestion) = vbYes Then                        .Cells(rFiCod.Row, 1).Resize(, 75).Value = Sheets("BASE").Cells(rCod.Row, 1).Resize(, 75).Value                      Exit For                    Else: Exit For                    End If                  Else: Sheets("DATABASE").Range("A" & LRd + 1).Resize(, 75).Value = _                          Sheets("BASE").Cells(rCod.Row, 1).Resize(, 75).Value                  End If                 Next rData              .AutoFilter            End With          End If      Next rCodEnd Sub

Se precisar de ajuste/alteração disponibilize o seu arquivo, com os códigos instalados e com as explicações/comentários nas planilhas.

 

Sugestão - ao responder só clique no botão "Citar" se for  necessário. Utilize preferencialmente o botão "Responder".

[ad48]

boa noite Osvaldo

 

obrigado por todas as informação

e boa vontade que você tem de me ajudar

ja que não sei  muito de vba

e não tenho muito conhecimento do funcionamento do  forum.

 

estou postando novo anexo agora acho que fiz melhor a explicação

da forma que deve funcionar,você pode modificar todas a macro

fazer da melhor forma.

 

anexoteste.xls

 

att.

 

 

[Visitante]

Fiz os testes no arquivo que você postou por último e, para executar a operação de copiar/colar cada registro da planilha BASE para a planilha DATABASE, o código está funcionando assim:

A verificação (que você trata por validação) quanto à existência do registro na DATABASE é feita comparando-se as colunas "A" e "BV", conforme você solicitou. Daí resulta:

1. Se uma das duas colunas for diferente, o código entende que se trata de um novo registro, e então o coloca na DATABASE.
2. Se as duas colunas forem iguais, ou seja, o registro já existe, é exibida a caixa pedindo confirmação se deseja atualizar o registro.
Neste caso, respondendo "Sim", o código cola sobre o registro existente e, respondendo "Não", o código não executa qualquer operação.

Não foi isso que você pediu?


Quanto aos demais códigos que você quer alterar, sugiro que você abra novos tópicos aqui no fórum, um tópico para cada questão.

[ad48]

boa tarde Osvaldo,

 

parabéns  pela sua explicação e sua ajuda

você tem um bom  conhecimento

ficou muito bom mesmo.

 

para outros códigos

que quero alterar

vou abrir outros  tópicos. 

este tópico foi resolvido e pode ser fechado.

 

meu muito obrigado.

at.