kaydet makrosu

[benoman]

Selam arkadaşkar,
Ekteki örnek çalışmada "giriş" sayfasına T.C kimlik numarasını girip kişi bilgilerine ulaştıktan sonra Kişiye ait bilgile "ve" sayfasına daha önce kayıt edilmemiş ise kayıt edilmesini eger "ve" sayfasında önceden kişinin kaydı var ise mükerrer kayıtları önlemek için kayıt etmek isteyip istemediğimi sorarak evet denmesi durumunda kayıt edilmesin hayır denmesi urumunda kayıt edilmemesini istiyorum..
ben makro ile kaydetmesini sağladım ama mükerrer kayıt yapmasını önleyemedim.. veri dogrulama ile ve sayfadaki siyah hücreler yardımı ile mükerrer kayıt girişini önlemeye çalıştım ama beceremedim.

yardımlarınız için şimdiden teşekkür ediyorum.

 

[erkanfun]

Buraya bütün programı koymak yerine,işin mantığını öğrenip kendin uygulasan senin için daha faydalı olur. İşin mantığını öğrenmek için de sorunla ilgili benzer basit bir dosya hazırla, burada sor.Yoksa, "alın yapın sonrada bana yollayın" mantığıyla hareket edersen olmaz.Böyle dersen soruna cevap verilebilmesi için ilk önce senin bütün programının kavranması sonra da çözüm aranması gerekir.Bununla da çok az kişi uğraşır.Ben şahsen bakarken sıkıldım çıktım.

 

[conari]

Giriş sayfasında
e4 hücresine
=EĞERSAY(ve!B3:B3293;B2)
(b2 hücresine girilen numaranın daha önce kaç kez girildiğini bulur.)

formülü giriniz.
Makroyu aşağıdaki şekilde değiştirin.


If Range("e4").Value = 0 Then
Sheets("Kayıt").Select
Range("b1:b9").Select
Selection.Copy
Sheets("ve").Select
Range("A15000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("ve").Select
Range("b2:b2").Select
Selection.ClearContents
Range("b2").Select
Else
Dim cevap
cevap = MsgBox("Zaten var Kayıt Edilsin mi?", vbYesNo + vbDefaultButton2 + vbQuestion, "Uyarı!!")
If cevap = 6 Then
Sheets("Kayıt").Select
Range("b1:b9").Select
Selection.Copy
Sheets("ve").Select
Range("A15000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("ve").Select
Range("b2:b2").Select
Selection.ClearContents
Range("b2").Select
End If
End If
End Sub

 

[benoman]

teşekkür

Sayın conari, sayın erkanfun ve daha öncede çeşitli katkılarda bulunan sayın leventim başta olmak bütün forum üyelerine bilgi paylaşımları için teşekkürler.
kısa tutmaya çalışacağım. sitem olarak algılamayın sayın erkanfun ama ben sadece ne yapmak istediğimi tam olarak anlatabilmek adına bütün çalışmayı gönderdim. tabiki asıl amaç ögrenmek, yoksa şunu benim için yapın demek gibi bir kabalık asla yapmam.. sadece beceremedim bir kaç farklı şey denedim olmadı ve zaten kıt olan bilgimde yetmedi üstüne forumdan bulduğum örneklerde aradığımı bulmadım iyice kafam karıştırdı.. sonuç başvuru=siz..

bilgi ve emeğini paylaşan herkese teşekkürler