Mükerrer veri girişini önleme

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..
 
G

Galus

Katılım
8 Eylül 2005
Mesajlar
476
Excel Vers. ve Dili
Excel 2003 - Türkçe
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..
 
G

Galus

Katılım
8 Eylül 2005
Mesajlar
476
Excel Vers. ve Dili
Excel 2003 - Türkçe
50 kişi görüntülemiş, kimsenin ilgisini çekmemiş.
 
A

AS3434

Özel Üye
Katılım
13 Ocak 2005
Mesajlar
1,820
Excel Vers. ve Dili
M.Office/Excel 2007 Türkçe
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:
G

Galus

Katılım
8 Eylül 2005
Mesajlar
476
Excel Vers. ve Dili
Excel 2003 - Türkçe
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..
 
A

AS3434

Özel Üye
Katılım
13 Ocak 2005
Mesajlar
1,820
Excel Vers. ve Dili
M.Office/Excel 2007 Türkçe
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.
 
G

Galus

Katılım
8 Eylül 2005
Mesajlar
476
Excel Vers. ve Dili
Excel 2003 - Türkçe
Ö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..
 
G

Galus

Katılım
8 Eylül 2005
Mesajlar
476
Excel Vers. ve Dili
Excel 2003 - Türkçe
Sonunda başardım. Eski kodları silip sadece verdiğiniz kodları girdim. Çok çok teşekkürler...
 
T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
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
 
G

Galus

Katılım
8 Eylül 2005
Mesajlar
476
Excel Vers. ve Dili
Excel 2003 - Türkçe
Sayın tahsinanarat,

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

Saygılar..
 
T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
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
 
G

Galus

Katılım
8 Eylül 2005
Mesajlar
476
Excel Vers. ve Dili
Excel 2003 - Türkçe
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.
 
T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Benim denediğim dosyanızda hata yoktu

Dosyanızı bir denermisiniz
 
G

Galus

Katılım
8 Eylül 2005
Mesajlar
476
Excel Vers. ve Dili
Excel 2003 - Türkçe
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..
 
A

AS3434

Özel Üye
Katılım
13 Ocak 2005
Mesajlar
1,820
Excel Vers. ve Dili
M.Office/Excel 2007 Türkçe
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.
 
T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Ö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.
 
G

Galus

Katılım
8 Eylül 2005
Mesajlar
476
Excel Vers. ve Dili
Excel 2003 - Türkçe
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.
 
G

Galus

Katılım
8 Eylül 2005
Mesajlar
476
Excel Vers. ve Dili
Excel 2003 - Türkçe
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...
 
A

AS3434

Özel Üye
Katılım
13 Ocak 2005
Mesajlar
1,820
Excel Vers. ve Dili
M.Office/Excel 2007 Türkçe
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.
Üst