• DİKKAT

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

Aynı veriyi tekrar girmemek için ne yapmak gerek

Katılım
9 Şubat 2010
Mesajlar
41
Excel Vers. ve Dili
2003TR
Daha önce girilmiş verilerin aynısını tekrar girmeyi nasıl önleriz.püf noktası varmı?
saygılar
 
ALT+F11 ile VBA düzenleyici açıyorsunuz. Oradaki kodları kopyalıyorsunuz. Kendi dosyanızda da VBA düzenleyici açıp Insert+Module ile bir module ekleyip içine yapıştırıyorsunuz.

.
 
Ali bey yardımlarınız için teşekkürler.Peki bu makroyu kitaptaki tüm sayfalarda ilgili sütunlarda nasıl aktif edebiliriz.örneğin,mükerrer 3 nolu kodu kopyaladım modül içine.aynı veriyi girince otomatik olarak tanıyor ama uyarı mesajını vermiyor."bu veri daha önce girilmişti"diye.sadece otomatik olarak metni tanıyıp kendisi tamamlıyor.bende daha önceden bu veri girilmiş deyip onu eklemiyorum sütuna.
soru şu:kitap içindeki diğer sayfaya geçtiğimde bu makro çalışmıyor galiba.aynı veriyi yeni veri gibi işliyor.bunu nasıl önlerim?yardımlarınız için şimdiden teşekkürler.
 
resimli makro oluşturma ve mevcut makroların kopyalanıp çalıştırılması,güvenlikdüzey ayarları hakkında kapsamlı bilgi içeren dokümanları nereden bulabilrim?
mesala,makroyu düzenle dediğimde kitap gizli olarak ayralanmış görünür yap diye mesaj geliyor.nerden görünür yapılıyor gizli kitaplar?
teşekkürler
 
Private Sub Worksheet_Change(ByVal Target As Range)
Static veri()
Static Say As Integer
Dim Sorgu As String
If Target.Address = "$A$1" Then Application.EnableEvents = False

On Error Resume Next
If IsError(Application.Match(Target.Value, veri, 0)) Then
On Error GoTo 0
Say = Say + 1
ReDim Preserve veri(1 To Say)
veri(Say) = Target.Value
Else:
Sorgu = MsgBox("Bu veriyi daha önce kullandınız." & vbCrLf & "Devam etmek istiyormusunuz?", vbCritical + vbYesNo, "Mükerrer Kayıt")
If Sorgu = vbNo Then Target.Value = Empty
End If
End If
Application.EnableEvents = True
End Sub


kırmızıyla işaretli kısma yani A1 hücresi yerine sütundaki tüm hücreleri mi girmem gerekiyor.Çünkü kodu çalıştıramadım.daha önce belirttiğim veri girişinde otamatik bulma işini excel kendisi yapıyor zaten ben makroyu çalıştırdığımı sanıyordum ama çalışmadı
acil cevap verirseniz sevinirim.zira yüzlerce firma isminin olduğu bir sütunda veri süzle çalışmak çok zaman alıyor.saygılarımla,şimdiden teşekkürler
 
Syn. mekanikçi,
Örnek bir dosya eklerseniz daha kolay yardım alabilirsiniz. Örneğin; nereye veri girdiğinizde kontrol yapılması gerekiyor, nereyi kontrol etmeli. Bunları örnek bir dosyada belirtin.
 
Syn. mekanikçi,
Örnek bir dosya eklerseniz daha kolay yardım alabilirsiniz. Örneğin; nereye veri girdiğinizde kontrol yapılması gerekiyor, nereyi kontrol etmeli. Bunları örnek bir dosyada belirtin.

dosya ekte gönderiyorum.internettn bulduğum firmaları kopyala yapıştır yaparak listeye ekliyorum.ama bazan aynı firmayı tekrar ekliyor.sonunda farklı olarak fazladan nokta varsa şirket isminin onu farklı olarak alıyor doğal olarak.yada altı çizgiliyse.web adresi email telefon adres
sütunlarında da tekrarlı veri girişini önleme yi yaptırabilir miyiz.yani B sütununa ilave olarak bu sütunlarda da aynı veri girilmesin.ben web adresi için gönderdiğiniz koda ekleme yaptım olmadı.

If Intersect(Target, Range("b1:b65536")) Is Nothing Or Target bu kısma ("b1:b65536";f1:f65536)) yazdım olmadı.
B,F,G,H,I sütunlarının hepsinde veri girişini önlemek istiyorum.
SORU 2:sayfa 1 deki firma isimleri 2 satıra 1 firma ismi girilerek yapılmış daha önce.bunları her satıra 1 firma olacak şekilde ve veri olan satırları silmeyecek şekilde ayarlayan bir makro var mı yada yapılabilir mi?tek tek elledüzenlemek çok zaman alacak o bakımdan.yardımlarınız için teşekkürler saygılarımla
 

Ekli dosyalar

dosya ekte gönderiyorum.internettn bulduğum firmaları kopyala yapıştır yaparak listeye ekliyorum.ama bazan aynı firmayı tekrar ekliyor.sonunda farklı olarak fazladan nokta varsa şirket isminin onu farklı olarak alıyor doğal olarak.yada altı çizgiliyse.web adresi email telefon adres
sütunlarında da tekrarlı veri girişini önleme yi yaptırabilir miyiz.yani B sütununa ilave olarak bu sütunlarda da aynı veri girilmesin.ben web adresi için gönderdiğiniz koda ekleme yaptım olmadı.

If Intersect(Target, Range("b1:b65536")) Is Nothing Or Target bu kısma ("b1:b65536";f1:f65536)) yazdım olmadı.
B,F,G,H,I sütunlarının hepsinde veri girişini önlemek istiyorum.
SORU 2:sayfa 1 deki firma isimleri 2 satıra 1 firma ismi girilerek yapılmış daha önce.bunları her satıra 1 firma olacak şekilde ve veri olan satırları silmeyecek şekilde ayarlayan bir makro var mı yada yapılabilir mi?tek tek elledüzenlemek çok zaman alacak o bakımdan.yardımlarınız için teşekkürler saygılarımla

diğer sütunlara da mükerrer kaydı önlemek için kodları nasıl yazıyoruz.acil yardım lütfen
 
Kod:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range[COLOR="Red"]("b1:f65536")) [/COLOR]Is Nothing Or Target = "" Then Exit Sub
For x = 1 To Sheets.Count
Say = WorksheetFunction.CountIf(Sheets(x).Range[COLOR="red"]("b1:f65536"), [/COLOR]Target)
knt = knt + Say
Next
If knt > 1 Then
MsgBox "Bu veri daha önce girilmiş.", vbCritical, "UYARI"
Target = ""
End If
End Sub

kırmızı olan yerler değiştirilmiştir
örnek ektedir.
 

Ekli dosyalar

3 sayfanında B sütunlarına veri doğrulama özel için formül yazıldı.B sütunlarına mükerrer kayıt girilemiyor.
Dosya ektedir.:cool:
 

Ekli dosyalar

Kod:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range[COLOR="Red"]("b1:f65536")) [/COLOR]Is Nothing Or Target = "" Then Exit Sub
For x = 1 To Sheets.Count
Say = WorksheetFunction.CountIf(Sheets(x).Range[COLOR="red"]("b1:f65536"), [/COLOR]Target)
knt = knt + Say
Next
If knt > 1 Then
MsgBox "Bu veri daha önce girilmiş.", vbCritical, "UYARI"
Target = ""
End If
End Sub

kırmızı olan yerler değiştirilmiştir
örnek ektedir.

C,D sütunlarında ki tarih bölümlerinde tekrara izin vermesi gerek.aynı tarihi tekrar girmek gerek.bunu nasıl ayarlarız
 
C,D sütunlarında ki tarih bölümlerinde tekrara izin vermesi gerek.aynı tarihi tekrar girmek gerek.bunu nasıl ayarlarız

Kod:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range("b1:b65536,e1:e65536,f1:f65536")) Is Nothing Or Target = "" Then Exit Sub
For x = 1 To Sheets.Count
Say = WorksheetFunction.CountIf(Sheets(x).Range("b1:f65536"), Target)
knt = knt + Say
Next
If knt > 1 Then
MsgBox "Bu veri daha önce girilmiş.", vbCritical, "UYARI"
Target = ""
End If
End Sub

kod düzeltmesini evren gizlen uzman yapmıştır örnek ektedir.
 

Ekli dosyalar

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range("b1:b65536,f1:f65536,g1:g65536,h1:h65536,i1:i65536")) Is Nothing Or Target = "" Then Exit Sub
For x = 1 To Sheets.Count
Say = WorksheetFunction.CountIf(Sheets(x).Range("b1:i65536"), Target)
knt = knt + Say
Next
If knt > 1 Then
MsgBox "Bu veri daha önce girilmiş.", vbCritical, "UYARI"
Target = ""
End If
End Sub


kodlarda yukardaki gibi değişiklik yaptım.h,i sütunlarını ekledim fazladan.sabah düzgün çalışıyordu şimdi çalışmıyor.sebebini bilmiyorum.kodlar yukardaki gibidir.ne yapmam gerek.saygılarımla
 
Kod:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range("b1:b65536,e1:i65536")) Is Nothing Or Target = "" Then Exit Sub
For x = 1 To Sheets.Count
Say = WorksheetFunction.CountIf(Sheets(x).Range("b1:i65536"), Target)
knt = knt + Say
Next
If knt > 1 Then
MsgBox "Bu veri daha önce girilmiş.", vbCritical, "UYARI"
Target = ""
End If
End Sub
kodu bu şekilde deneyiniz
örnek ekte
 

Ekli dosyalar

Son düzenleme:
#16 nolu mesajı güncelledim lütfen inceleyiniz.
 
Geri
Üst