Soru Mükerrer Kayıdı Atlayarak Engelleme

S

Sefa1994

Katılım
12 Mart 2020
Mesajlar
71
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
13-02-2024
Merhaba, forumda mükerrer kayıt engelleme ile ilgili çok çözüm var fakat benim problemimle ilgili bi çözüm bulamadım var da gözden kaçırdıysam affola. Benim sorunum örneğin; A sütununda A1-A2-A3-A4'e aynı fatura numarasını girebileyim ama A5 e farklı bi fatura numarası girdikten sonra A6 ya 1-2-3-4 teki aynı fatura numarasını girmemi engellesin. Yani alt alta girebileyim fakat araya bi veri girdikten sonra engellesin. Belki biraz ütopik ama var mıdır bi çözümü? Yardımcı olanlara şimdiden teşekkür ederim. İyi çalışmalar.
 
kulomer46

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,513
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
08-06-2027
Merhaba

Sorunuzu Excel'e Yeni Başlayanlar bölümünde sorduğunuzun farkındayım.
Ben Ek 'teki Makro Çözümlü dosya ile kendi çözümümü ekliyorum.

Sağlıcakla Kalınız...

İlgili Kod
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub
If Target.Column = 1 And Target.Row > 2 Then

    If Target.Value = Target.Offset(-1, 0).Value Then
  
    Else
        For i = Target.Row - 2 To 1 Step -1     
            If Target.Value = Cells(i, 1) Then
          
                Target.Select
                Target.Interior.Color = RGB(255, 192, 0)
                Cells(i, 1).Interior.Color = RGB(255, 192, 0)
              
                MsgBox "Şu an  A" & Target.Row & "  hücresine girdiğiniz  " & Target.Value & "  değeri,  A" & i & "  hücresine daha önce girilmiştir" _
                & Chr(10) & Chr(10) & "Bu yüzden  A" & Target.Row & "  hücresindeki  " & Target.Value & "  değeri silinecektir" & Chr(10) & Chr(10) & _
                "Sağlıcakla Kalınız", , "MÜKERRER KAYIT"
              
                Target = ""
                Target.Interior.Color = xlNone
                Cells(i, 1).Interior.Color = xlNone             
                Exit Sub     
              
            End If     
          
        Next 
    End If 
End If

End Sub


İlgili Resim
215354
 

Ekli dosyalar

Son düzenleme:
S

Sefa1994

Katılım
12 Mart 2020
Mesajlar
71
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
13-02-2024
kulomer46' Alıntı:
Merhaba

Sorunuzu Excel'e Yeni Başlayanlar sordunuz.
Bende Ek 'teki Makro Çözümlü dosya ile kendi çözümümü ekliyorum.

Sağlıcakla Kalınız...

İlgili Kod
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub
If Target.Column = 1 And Target.Row > 2 Then

    If Target.Value = Target.Offset(-1, 0).Value Then
   
    Else
        For i = Target.Row - 2 To 1 Step -1      
            If Target.Value = Cells(i, 1) Then
           
                Target.Select
                Target.Interior.Color = RGB(255, 192, 0)
                Cells(i, 1).Interior.Color = RGB(255, 192, 0)
               
                MsgBox "Şu an  A" & Target.Row & "  hücresine girdiğiniz  " & Target.Value & "  değeri,  A" & i & "  hücresine daha önce girilmiştir" _
                & Chr(10) & Chr(10) & "Bu yüzden  A" & Target.Row & "  hücresindeki  " & Target.Value & "  değeri silinecektir" & Chr(10) & Chr(10) & _
                "Sağlıcakla Kalınız", , "MÜKERRER KAYIT"
               
                Target = ""
                Target.Interior.Color = xlNone
                Cells(i, 1).Interior.Color = xlNone              
                Exit Sub      
               
            End If      
           
        Next  
    End If  
End If

End Sub


İlgili Resim
Ekli dosyayı görüntüle 215352
Genişletmek için tıkla ...
Elinize kolunuza sağlık çok teşekkür ederim yalnız altın üye olmadığım için çalışmanızı göremiyorum müsait olduğunuzda bi dosya paylaşma sitesinden link atabilir misiniz rica etsem? çok teşekkür ederim tekrar.
 
S

Sefa1994

Katılım
12 Mart 2020
Mesajlar
71
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
13-02-2024
kulomer46' Alıntı:
Selamlar...
Genişletmek için tıkla ...
Merhabalar, kodları farklı bi sayfaya yüklediğimde döngüye giriyor ve excell kapanıyor a sütununda b sütununa aktarmaya çalışırken de cells leri 2 yapıyorum fakat bu sefer a sütununda yazılı diyip tekrar döngüye giriyor. neyi yanlış yapıyorum acaba?
 
kulomer46

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,513
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
08-06-2027
Değerli Arkadaşım

Program sadece A sütunundaki mükerrer kayıtları kontrol etmek üzere kodlanmıştır.

İstediğiniz başka bir sütun için mükerrer kayıt kontrolü yapmak isterseniz aşağıda yazılanları uygulayınız.

Kod Bloğunun 2. Satırındaki (aşağıda koyu ile belirttiğim) 1 rakamını silip yerine işlem yapılmasını istediğiniz sütun numarasını girmelisiniz.
If Target.Column = 1 And Target.Row > 2 Then

Kod Bloğunun her yerine bakıp, Cells(i, 1) yazan kodları bulup, koyu ile belirttiğim 1 rakamını silip yerine işlem yapılmasını istediğiniz sütun numarasını girmelisiniz.

Birde aşağıdaki msgbox kodundaki koyu ile yazılı A yerine işlem yapacağınız Sütun adını girmelisiniz. ( Örneğin B )

MsgBox "Şu an A" & Target.Row & " hücresine girdiğiniz " & Target.Value & " değeri, A" & i & " hücresine daha önce girilmiştir" _
& Chr(10) & Chr(10) & "Bu yüzden A" & Target.Row & " hücresindeki " & Target.Value & " değeri silinecektir" & Chr(10) & Chr(10) & _
"Sağlıcakla Kalınız", , "MÜKERRER KAYIT"

Bunun dışında programın hata vermeden çalışması lazım.

Kolay Gelsin.
Selamlar...
 
S

Sefa1994

Katılım
12 Mart 2020
Mesajlar
71
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
13-02-2024
kulomer46' Alıntı:
Değerli Arkadaşım

Program sadece A sütunundaki mükerrer kayıtları kontrol etmek üzere kodlanmıştır.

İstediğiniz başka bir sütun için mükerrer kayıt kontrolü yapmak isterseniz aşağıda yazılanları uygulayınız.

Kod Bloğunun 2. Satırındaki (aşağıda koyu ile belirttiğim) 1 rakamını silip yerine işlem yapılmasını istediğiniz sütun numarasını girmelisiniz.
If Target.Column = 1 And Target.Row > 2 Then

Kod Bloğunun her yerine bakıp, Cells(i, 1) yazan kodları bulup, koyu ile belirttiğim 1 rakamını silip yerine işlem yapılmasını istediğiniz sütun numarasını girmelisiniz.

Birde aşağıdaki msgbox kodundaki koyu ile yazılı A yerine işlem yapacağınız Sütun adını girmelisiniz. ( Örneğin B )

MsgBox "Şu an A" & Target.Row & " hücresine girdiğiniz " & Target.Value & " değeri, A" & i & " hücresine daha önce girilmiştir" _
& Chr(10) & Chr(10) & "Bu yüzden A" & Target.Row & " hücresindeki " & Target.Value & " değeri silinecektir" & Chr(10) & Chr(10) & _
"Sağlıcakla Kalınız", , "MÜKERRER KAYIT"

Bunun dışında programın hata vermeden çalışması lazım.

Kolay Gelsin.
Selamlar...
Genişletmek için tıkla ...
hocam sanırım sorunu buldum
Target = ""
Target.Interior.Color = xlNone
Cells(i, 2).Interior.Color = xlNone
kısmında ---Target = ""---- kısmında ---" "---- arasına bi yazı yazınca döngüye girmiyor. atıyorum "farklı fatura no" yazınca sildikten sonra bu yazıyı çıkartıyor. ama sonrasında o yazıyı da sildirmiyor o kısmı boş bırakmıyor yanlış yazılan hücreyi yani yeni bi veri girene kadar.
 
S

Sefa1994

Katılım
12 Mart 2020
Mesajlar
71
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
13-02-2024
kulomer46' Alıntı:
Değerli Arkadaşım

Program sadece A sütunundaki mükerrer kayıtları kontrol etmek üzere kodlanmıştır.

İstediğiniz başka bir sütun için mükerrer kayıt kontrolü yapmak isterseniz aşağıda yazılanları uygulayınız.

Kod Bloğunun 2. Satırındaki (aşağıda koyu ile belirttiğim) 1 rakamını silip yerine işlem yapılmasını istediğiniz sütun numarasını girmelisiniz.
If Target.Column = 1 And Target.Row > 2 Then

Kod Bloğunun her yerine bakıp, Cells(i, 1) yazan kodları bulup, koyu ile belirttiğim 1 rakamını silip yerine işlem yapılmasını istediğiniz sütun numarasını girmelisiniz.

Birde aşağıdaki msgbox kodundaki koyu ile yazılı A yerine işlem yapacağınız Sütun adını girmelisiniz. ( Örneğin B )

MsgBox "Şu an A" & Target.Row & " hücresine girdiğiniz " & Target.Value & " değeri, A" & i & " hücresine daha önce girilmiştir" _
& Chr(10) & Chr(10) & "Bu yüzden A" & Target.Row & " hücresindeki " & Target.Value & " değeri silinecektir" & Chr(10) & Chr(10) & _
"Sağlıcakla Kalınız", , "MÜKERRER KAYIT"

Bunun dışında programın hata vermeden çalışması lazım.

Kolay Gelsin.
Selamlar...
Genişletmek için tıkla ...
çözümle dedikten sonra hatayı Exit Sub tan sonraki End If Kısmında gösteriyor.
 
kulomer46

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,513
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
08-06-2027
Arkadaşım Merhaba

Koddaki takılmayı buldum

Kod bloğundaki 6. satırda bulunan

If Target.Value = Cells(i, 1) Then

kodunu silip yerine

If Target.Value = Cells(i, 1) And Len(Trim(Target.Value)) > 0 Then

kod satırını yapıştırın.

Benim farkettiğim sorun çözülecektir.

Selamlar...
 
S

Sefa1994

Katılım
12 Mart 2020
Mesajlar
71
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
13-02-2024
kulomer46' Alıntı:
Arkadaşım Merhaba

Koddaki takılmayı buldum

Kod bloğundaki 6. satırda bulunan

If Target.Value = Cells(i, 1) Then

kodunu silip yerine

If Target.Value = Cells(i, 1) And Len(Trim(Target.Value)) > 0 Then

kod satırını yapıştırın.

Benim farkettiğim sorun çözülecektir.

Selamlar...
Genişletmek için tıkla ...
çok çok teşekkür ederim sorun çözüldü, bilginize elinize sağlık selamlar, sağlıcakla kalın.
 
A

alicimri

Katılım
12 Aralık 2015
Mesajlar
1,207
Excel Vers. ve Dili
Türkçe Ofis 2007
Aşağıdaki kodu ilgili sayfanın modülüne yapıştırın Sadece A sütunu için çalışıyor. Mükerrer kayıt siliniyor o hücreye dönüyor.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 1 Then
If Application.CountIf(Range("A1:A" & Target.Row - 1), Target) > 0 And Target = Range("A" & Target.Row - 1) Or Application.CountIf(Range("A1:A" & Target.Row - 1), Target) = 0 And Target <> Range("A" & Target.Row - 1) Then
Else
Target.Value = ""
Target.Select
End If
End If
End Sub
Sorun çözülmüş alternatif olsun.
 
S

Sefa1994

Katılım
12 Mart 2020
Mesajlar
71
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
13-02-2024
alicimri' Alıntı:
Aşağıdaki kodu ilgili sayfanın modülüne yapıştırın Sadece A sütunu için çalışıyor. Mükerrer kayıt siliniyor o hücreye dönüyor.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 1 Then
If Application.CountIf(Range("A1:A" & Target.Row - 1), Target) > 0 And Target = Range("A" & Target.Row - 1) Or Application.CountIf(Range("A1:A" & Target.Row - 1), Target) = 0 And Target <> Range("A" & Target.Row - 1) Then
Else
Target.Value = ""
Target.Select
End If
End If
End Sub
Sorun çözülmüş alternatif olsun.
Genişletmek için tıkla ...
elinize sağlık teşekkürler
 
kulomer46

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,513
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
08-06-2027
alicimri' Alıntı:
Aşağıdaki kodu ilgili sayfanın modülüne yapıştırın Sadece A sütunu için çalışıyor. Mükerrer kayıt siliniyor o hücreye dönüyor.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 1 Then
If Application.CountIf(Range("A1:A" & Target.Row - 1), Target) > 0 And Target = Range("A" & Target.Row - 1) Or Application.CountIf(Range("A1:A" & Target.Row - 1), Target) = 0 And Target <> Range("A" & Target.Row - 1) Then
Else
Target.Value = ""
Target.Select
End If
End If
End Sub
Sorun çözülmüş alternatif olsun.
Genişletmek için tıkla ...
Elinize Sağlık
Selamlar...
 
T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Peki B sütununda aynı kayıt varsa kaydedilen satırın tamamını silmek için kod nasıl revize edilir.
 
kulomer46

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,513
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
08-06-2027
Merhaba

B sütununda aynı kayıt varsa kaydedilen satırın tamamını silen kod aşağıdadır.

Kolay Gelsin...

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Target.Column = 2 And Target.Row > 2 Then
  
    If Target.Value = Target.Offset(-1, 0).Value Then
  
    Else

        For i = Target.Row - 2 To 1 Step -1
      
            If Target.Value = Cells(i, 2) And Len(Trim(Target.Value)) > 0 Then
          
                Target.Select
                Target.Interior.Color = RGB(255, 192, 0)
                Cells(i, 2).Interior.Color = RGB(255, 192, 0)
              
                MsgBox "Şu an  B" & Target.Row & "  hücresine girdiğiniz  " & Target.Value & "  değeri,  B" & i & "  hücresine daha önce girilmiştir" _
                & Chr(10) & Chr(10) & "Bu yüzden  " & Target.Row & ".  satır tamamen silinecektir" & Chr(10) & Chr(10) & _
                "Sağlıcakla Kalınız", , "MÜKERRER KAYIT"
              
                Rows(Target.Row & ":" & Target.Row).Delete Shift:=xlUp

                Cells(i, 2).Interior.Color = xlNone
              
                Exit Sub
          
            End If
      
        Next
  
    End If
  
End If



End Sub
 
Son düzenleme:
S

Sefa1994

Katılım
12 Mart 2020
Mesajlar
71
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
13-02-2024
kulomer46' Alıntı:
Merhaba

B sütununda aynı kayıt varsa kaydedilen satırın tamamını silen kod aşağıdadır.

Kolay Gelsin...

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Target.Column = 2 And Target.Row > 2 Then
 
    If Target.Value = Target.Offset(-1, 0).Value Then
 
    Else

        For i = Target.Row - 2 To 1 Step -1
     
            If Target.Value = Cells(i, 2) And Len(Trim(Target.Value)) > 0 Then
         
                Target.Select
                Target.Interior.Color = RGB(255, 192, 0)
                Cells(i, 2).Interior.Color = RGB(255, 192, 0)
             
                MsgBox "Şu an  B" & Target.Row & "  hücresine girdiğiniz  " & Target.Value & "  değeri,  B" & i & "  hücresine daha önce girilmiştir" _
                & Chr(10) & Chr(10) & "Bu yüzden  " & Target.Row & ".  satır tamamen silinecektir" & Chr(10) & Chr(10) & _
                "Sağlıcakla Kalınız", , "MÜKERRER KAYIT"
             
                Rows(Target.Row & ":" & Target.Row).Delete Shift:=xlUp

                Cells(i, 2).Interior.Color = xlNone
             
                Exit Sub
         
            End If
     
        Next
 
    End If
 
End If



End Sub
Genişletmek için tıkla ...
Ellerine sağlık üstadım.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst