Página 1 de 3
Duplicidade no modelo de cadastro
Enviado: Sex Jan 29, 2010 12:20 pm
por jovemlima
Ola, Desde já agradeço pela paciencia.
Gostaria de colocar um modelo para evitar a duplicidade no cadastro. Porem os comandos nao deram certo, entao vou anexar uma imagem do que gostaria que acontece, mas nao do conta de fazer....Espero que me ajudem.
Exemplo:
Sub EliminaDuplicidades( )
Set rfonte = Application.InputBox("Informe Qual o Range?", _
Title:="Range(ColunaA)", Type:=8)
rfonte.Select
Selection.Copy
Sheets("Plan2").Select
Range("a1").Select
ActiveSheet.Paste
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
For Each c In Selection.Cells
If c.Value = c.Offset(1, 0).Value Then
c.Offset(1, 0).Delete Shift:=xlUp
End If
Next
End Sub
Re: Duplicidade no modelo de cadastro
Enviado: Sex Jan 29, 2010 12:55 pm
por webmaster
Luiz,
A idéia é saber o que você não gostaria que fosse duplicado. Nome? ID? Código? Enfim.
Assim, antes de salvar o registro, colocaríamos uma rotina de verificação para ver se ocorrerá uma duplicação.
Abraços
Re: Duplicidade no modelo de cadastro
Enviado: Sex Jan 29, 2010 1:57 pm
por jovemlima
Ola,
Neste caso gostaria que Prontuario nao desse duplicidade.
Obrigado.
sds
luiz
Re: Duplicidade no modelo de cadastro
Enviado: Sáb Jan 30, 2010 12:30 pm
por webmaster
Luiz,
Ajustei o modelo cadastro para suportar a funcionalidade que deseja. Depois farei uma versão mais completa para colocar no blog, mas por enquanto, verifique a que está em anexo. Tive que fazer algumas modificações no código. Vamos discutindo-as conforme as dúvidas surgirem.
Abraços
Re: Duplicidade no modelo de cadastro
Enviado: Sáb Jan 30, 2010 10:27 pm
por joseA
Segue um procedimento, não tem nada a ver com ModeloCadastro, adaptando dá para fazer o que vc deseja, faça um teste aí:
Código: Selecionar todos
Private Sub CommandButton1_Click()
Dim lastRow As Long
Dim rg As Range
'Ativar a primeira planilha
ThisWorkbook.Worksheets("Cadastro de Contrato").Activate
' Verifica qual a ultima linha preenchida
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
' Guarda a area a procurar
Set rg = Range("A4:A" & lastRow)
' Caso não encontre nenhum nome igual
If rg.Find(TextBox1.Text) Is Nothing Then
If MsgBox("Contrato não cadastrado. Deseja cadastrar contrato: " & Me.TextBox1 & "?", vbYesNo + vbQuestion, "Contratos") = vbNo Then
Exit Sub
End If
Cells(lastRow + 1, 1) = TextBox1.Text
Cells(lastRow + 1, 2) = TextBox2.Text
Cells(lastRow + 1, 3) = TextBox3.Text
Cells(lastRow + 1, 4) = TextBox4.Text
Cells(lastRow + 1, 5) = TextBox5.Text
MsgBox "O contrato: " & Me.TextBox1 & " foi registrado com sucesso!!!", 64, "Contratos"
'Limpar as caixa de texto
TextBox1.Value = Empty
TextBox2.Value = Empty
TextBox3.Value = Empty
TextBox4.Value = Empty
TextBox5.Value = Empty
'Colocar o foco na primeira caixa de texto
TextBox1.SetFocus
Sheets("Plan2").Activate
Else
MsgBox "Não é possível inserir este contrato, o mesmo já existe!", vbCritical
End If
End Sub
Re: Duplicidade no modelo de cadastro
Enviado: Seg Fev 01, 2010 3:19 pm
por jovemlima
Ola.
Vou anexar a planilha pra vcs me ajudarem, porque esta tudo blz, porem agora quando vou alterar ele ve tudo como duplicidade....Tem como arrumar?
E este modelo do jose não consegui adequar ele na planilha de cadastro....
sds
luiz
Re: Duplicidade no modelo de cadastro
Enviado: Ter Fev 02, 2010 2:30 pm
por webmaster
Luiz,
Precisei fazer alguns ajustes na função. Agora está funcionando.
Abraços
Re: Duplicidade no modelo de cadastro
Enviado: Qua Fev 03, 2010 7:29 am
por jovemlima
Ficou muito boa....Valeu.
Obrigado, vou mexer mais um pouco e vou colocando aqui, obrigado.
sds
luiz
Re: Duplicidade no modelo de cadastro
Enviado: Qua Fev 03, 2010 8:32 am
por webmaster
Ficou tão legal que logo vou colocar isso na planilha oficial.
Valeu a inspiração!
Re: Duplicidade no modelo de cadastro
Enviado: Qui Out 27, 2011 7:44 pm
por noxios
webmaster escreveu:Ficou tão legal que logo vou colocar isso na planilha oficial.
Valeu a inspiração!
onde posso baixar este exemplo?
obrigado