mükerer verilerde (sutunlar arası bağımsız olarak) uyarı versin

[numan şamil]

Merhaba forum üyeleri
Hepinize iyi çalışmalar
Ekli dosyada açıklamada bulunduğum sorunun çözülmesi için yardımlarınızı bekliyorum

 

[Ömer]

Merhaba,

Mükerrerlik kontrolü sütunlar arası 2 sütun atlayarak mı yapılcak? Diğer sütunlarda yapılmayacak mı?

 

[numan şamil]

Merhaba Ömer Bey
Mükererlik kontrolü sadece belirtilen sutunlarda diğer sutunlarda yapılmayacak (örnek te 2 şer sutun atlayarak belirttim gerçek dosyada 11'er atlayarak )
Toplam 12 sutunda mükererlik kontrolü yapılacaktır.

 

[Ömer]

gerçek dosyada 11'er atlayarak )
Toplam 12 sutunda mükererlik kontrolü yapılacaktır.

Bu ölçütü biraz daha açarsanız kodu ona göre yazayım.

11 sütun atlayarak yazacak ve toplam 12 sütun. Ayrıca satır kontrolü var mu yoksa tüm satırda mı olacak.

İlk sütun A mı olacak ve buna göre 2. sütun M mi olacak?

 

[numan şamil]

Ömer Hocam
Eksik açıklama için kusura bakma
1)ilk sutun "c" mükererlik kontrolü her sutunda 3, satırdan 655336 arasında her satırda olacaktır
2) ikinci sutun "M" (Burda yanlış olarak 11'er sutun atlayacak demiştim 11'er değil 9'ar sutun atlayarak olacak

Yani "C","M","W","AG","AQ","BA","BK","BU","CE","CO","CY",DI" sutunlarda bağımsız şekilde mükererlik kontrolü olacaktır

 

[Ömer]

Sayfanın kod bölümüne:

Yeşil olan bölümün başındaki tek tırnak işaretini kaldırırsanız uyarı mesajından sonra mükerrer girilen veri silinir.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Wf As WorksheetFunction, aLan As Range, sAy As Long
 
    If Intersect(Target, [C:DI]) Is Nothing Then Exit Sub
    
    Set Wf = WorksheetFunction
    
    With Target
        
        If .Row < 3 Or Not (.Column - 3) Mod 10 = 0 Then Exit Sub
        If .Value = "" Then Exit Sub
        
        Set aLan = Range(Cells(3, .Column), Cells(.Row, .Column))
        
        sAy = Wf.CountIf(aLan, .Value)
        
        If sAy > 1 Then
            MsgBox .Value & " Değeri Mükerrerdir"
           [COLOR=teal] '.ClearContents
[/COLOR]        End If
                
    End With
 
End Sub

 

[numan şamil]

Ömer Hocam
Ellerinize sağlık kodlar istediğim gibi çalışıyor
iyi çalışmalar