• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Mükerrer veri girişini önleme

  • Konbuyu başlatan Konbuyu başlatan Galus
  • Başlangıç tarihi Başlangıç tarihi
G

Galus

Katılım
8 Eylül 2005
Mesajlar
476
Excel Vers. ve Dili
Excel 2003 - Türkçe
Formül, Reçete ve Üretim sayfalarından oluşan çalışmamda Reçete sayfasındaki kaydet butonu ile formülden gelen veriler Üretim sayfasına yazdırılıyor. Eklenmesini istediğim Kaydet butonuna basıldığında veriler Üretim sayfasına gitmeden önce Üretim Sayfasında A kolonuna arama yaptırtıp aynı LOT numarasının girişinin engellenmesi. Aynı LOT numarası varsa ekrana uyarı versin mükerer veri girişi önlensin.

Teşekkürler..
 
Reçete sayfasında G1 hücresine LOT numarası girilmemişse veya aynı numara girilmişse kaydet butonuna bastığında ekrana uyarı mesajı gelsin. Aynı veri Üretim sayfasına aktarılmasın.

Teşekkürler..
 
50 kişi görüntülemiş, kimsenin ilgisini çekmemiş.
 
Kodlarınızın en altına Şu iki satırı ilave edin.

Kod: 
Sheets("Recete").Select
  [g1] = [g1] + 1

Kaydet butonuna her basışınızda Reçete sayfanızdaki LOT No otomatik olarak 1 artacaktır.

Kodlarınızın kısaltılmış hali.

Kod: 
Sub KAYDET()
Sheets("Uretim").Select
Rows("1:12").Insert Shift:=xlDown
Sheets("Recete").[F1:G1].Copy
Sheets("Uretim").[A1].PasteSpecial Paste:=xlPasteValues
Sheets("Recete").[B6].Copy
Sheets("Uretim").[C1].PasteSpecial Paste:=xlPasteValues
Sheets("Recete").[B12:B22].Copy
Sheets("Uretim").[D1].PasteSpecial Paste:=xlPasteValues
Sheets("Recete").[d12:d22].Copy
Sheets("Uretim").[e1].PasteSpecial Paste:=xlPasteValues
[A1].Select
Application.CutCopyMode = False
Sheets("Recete").Select
[g1] = [g1] + 1
End Sub
 
Son düzenleme:
AS3434' Alıntı:
Kaydet butonuna her basışınızda Reçete sayfanızdaki LOT No otomatik olarak 1 artacaktır.

[/CODE]
Genişletmek için tıkla ...

Sayın AS3434,

Önce ilgi ve alakanız için teşekkürler. LOT numaraları manuel girilirse yani otomatik 1 artmazsa nasıl yapabiliriz?

Teşekkürler..
 
Yine sizin kodlarınız üzerinden giderek, şöyle birşey olabilir.

Kod: 
Sub KAYDET()
Set s1 = Sheets("Recete")
Set s2 = Sheets("Uretim")
r = s2.[b65536].End(3).Row
For Each tek In s2.Range("b1:b" & r)
If s1.[g1] = tek Then
MsgBox ("DİKKAT!!! Mükerer Kayıt Yapıyorsunuz")
Exit Sub
End If: Next
Sheets("Uretim").Select
Rows("1:12").Insert Shift:=xlDown
s1.[F1:G1].Copy
s2.[A1].PasteSpecial Paste:=xlPasteValues
s1.[B6].Copy
s2.[C1].PasteSpecial Paste:=xlPasteValues
s1.[B12:B22].Copy
s2.[D1].PasteSpecial Paste:=xlPasteValues
s1.[d12:d22].Copy
s2.[e1].PasteSpecial Paste:=xlPasteValues
[A1].Select
Application.CutCopyMode = False
[COLOR=green]'s1.Select[/COLOR]
[COLOR=green]'[g1] = [g1] + 1[/COLOR]
End Sub

Otomatik sıra nosu için, yeşil satırların başındaki tırnak işaretini silin.
 
Özür dilerim. Bir türlü beceremedim. Kodları girince eror verip excel düşünüyor. Sizden kodları eklemenizi rica etsem çok mu masraflı olurum; saygılar..
 
Sonunda başardım. Eski kodları silip sadece verdiğiniz kodları girdim. Çok çok teşekkürler...
 
SN.AS3434 yine döktürmüşsünüz, elinize sağlık güzel bir çalışma olmuş,

r = s2.[b65536].End(3).Row
For Each tek In s2.Range("b1:b" & r)
If s1.[g1] = tek Then

Sn. Galus, sizin örneğinize göre (Sn.AS3434'den özür dileyerek, gözden kaçmış olabilir)
r = s2.[a65536].End(3).Row
For Each tek In s2.Range("a1:a" & r)
If s1.[f1] = tek Then

şeklinde olması gerekiyor, biraz önce bende incelediğimde fark ettim
 
Sayın tahsinanarat,

İlgi ve alakanıza teşekkürler.. Kodu ekleyip göndermeniz münkün mü?

Saygılar..
 
Sayın AS3434'ün kodları mevcut zaten, sizin örneğinize göre saadece yukarıda belirttiğim şekilde değişiklik yapmanız yeterli, yinede istiyorsanız buyurun (sn. AS3434 Hocam, sakın saygısızlık olarak kabul etmeyin, sizlere sagımız sonsuzdur.)
Sub KAYDET()
Set s1 = Sheets("Recete")
Set s2 = Sheets("Uretim")
r = s2.[a65536].End(3).Row
For Each tek In s2.Range("a1:a" & r)
If s1.[f1] = tek Then
MsgBox ("DİKKAT!!! Mükerer Kayıt Yapıyorsunuz")
Exit Sub
End If: Next
Sheets("Uretim").Select
Rows("1:12").Insert Shift:=xlDown
s1.[F1:G1].Copy
s2.[A1].PasteSpecial Paste:=xlPasteValues
s1.[B6].Copy
s2.[C1].PasteSpecial Paste:=xlPasteValues
s1.[B12:B22].Copy
s2.[D1].PasteSpecial Paste:=xlPasteValues
s1.[d12:d22].Copy
s2.[e1].PasteSpecial Paste:=xlPasteValues
[A1].Select
Application.CutCopyMode = False
's1.Select
'[f1] = [f1] + 1
End Sub
 
Sayın tahsinanarat,
İlgi ve alakanıza teşekkürler..
Kodlarınızı yapıştırdım. Herşeye "DİKKAT!!! Mükerer Kayıt Yapıyorsunuz" yazıyor. Rakam girsem de girmesemde.
 
Benim denediğim dosyanızda hata yoktu

Dosyanızı bir denermisiniz
 
Sayın tahsinanarat,
İlgi ve alakanıza tekrar tekrar teşekkürler..

Siz G1 yerine F1 hücresine tanımlamışsınız. Onun için çalıştıramamışım.

Saygılar..
 
tahsinanarat' Alıntı:
r = s2.[b65536].End(3).Row
For Each tek In s2.Range("b1:b" & r)
If s1.[g1] = tek Then

Sn. Galus, sizin örneğinize göre (Sn.AS3434'den özür dileyerek, gözden kaçmış olabilir)
r = s2.[a65536].End(3).Row
For Each tek In s2.Range("a1:a" & r)
If s1.[f1] = tek Then

şeklinde olması gerekiyor, biraz önce bende incelediğimde fark ettim
Genişletmek için tıkla ...

Sayın tahsinanarat
LOT No kontrolunun Üretim sayfasının B sütununda yapılması gerekli.
Orjinal dosyada sizin kontrolunu yaptığınız F1 hücresinde LOT NO : kaydı var. G1 hücresi ise numara yazılan hücre.
Burada amaç G1 hücresine girilen numaranın Üretim sayfasında B sütununda olup olmadığını denetlemek.
 
Özür, G1 hücresinde ben tarih olduğunu sanmıştım, tersten yazılmış 26082007 diye düşünmüştüm, siz haklısınız.
 
tahsinanarat' Alıntı:
Özür, G1 hücresinde ben tarih olduğunu sanmıştım, tersten yazılmış 26082007 diye düşünmüştüm, siz haklısınız.
Genişletmek için tıkla ...
Hocam, haklısınız o zaten tersten yazılmış tarih ama öyle kullanıyoruz. Kusura bakmayınız. Asıl ben özür dilerim.
 
Hocam,

Sayfalara koruma koyunca makrolar çalışmıyor. "Range sınıfının Insert yöntemi başarısız." diye eror veriyor. Sayfa korumadaki bütün seçenekleri işaretli yaptım gene olmadı. Üreteim sayfasına koruma koymanın başka yolu var mı?

Saygılar...
 
Kodları şöyle düzeltin.
Kırmızı satırları ilave edin.
ŞİFRE 12345

Kod: 
Sub KAYDET()
Set s1 = Sheets("Recete")
Set s2 = Sheets("Uretim")
r = s2.[b65536].End(3).Row
For Each tek In s2.Range("b1:b" & r)
If s1.[g1] = tek Then
MsgBox ("DİKKAT!!! Mükerer Kayıt Yapıyorsunuz")
Exit Sub
End If: Next
Sheets("Uretim").Select
[COLOR=red]'Koruma kaldırılırken şifre sormasın derseniz aşağıdaki kodları kullanın[/COLOR]
[COLOR=red]'ActiveSheet.unProtect Password:="12345"[/COLOR]
[COLOR=red]ActiveSheet.Unprotect[/COLOR]
Rows("1:12").Insert Shift:=xlDown
s1.[F1:G1].Copy
s2.[A1].PasteSpecial Paste:=xlPasteValues
s1.[B6].Copy
s2.[C1].PasteSpecial Paste:=xlPasteValues
s1.[B12:B22].Copy
s2.[D1].PasteSpecial Paste:=xlPasteValues
s1.[d12:d22].Copy
s2.[e1].PasteSpecial Paste:=xlPasteValues
[A1].Select
Application.CutCopyMode = False
[COLOR=red]ActiveSheet.Protect Password:="12345"[/COLOR]
End Sub
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst