Birkaç kritere göre mükerrer kayıt tespiti

[Eser Gökay]

arkadaslar iyi aksamlar. sorum ektedir. ilgilenenlere tesekkur ediyorum.

 

[mesuttasar]

Belge numarasına göre mükerrer olup olmadığı incelenmesi uygunmu?

 

[mesuttasar]

Sayfa 1 code bölümüne aşağıdaki kodları yapıştıman gerekiyor.J sütunu Belge Numarasının yazılı olduğu sütun olduğundan dolayı mükerrerliği bu kıstasa göre arayan kodlar bunlar.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For j = [j65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("j1:j" & j), Cells(j, "j")) > 1 Then Rows(j).Delete
 Next
End Sub

 

[Eser Gökay]

sayın mesut bey. biraz geciktim ozur dilerim. aramayı sadece belge numarasına göre yapamayız. cunku farklı firmalardan aldıgınız faturaların numarası aynı olabilir. (genel de olur). o yuzden sarıyla isaretli alanın tamamı aynı olmalı. Onun dısında kodları mukerrer kaydı silecek sekilde yazmısız silmesini istemiyorum. sadece mukerrer olduguna dair bilgi vermesi yeterli.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu ilgili sayfanın kod bölümüne uygulayıp denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, [G4:G65536,I4:J65536,M4:M65536]) Is Nothing Then Exit Sub
    If IsEmpty(Target) Or InStr(1, Target.Address, ":") <> 0 Then Exit Sub
    If Cells(Target.Row, "G") <> "" And Cells(Target.Row, "I") <> "" And Cells(Target.Row, "J") <> "" And Cells(Target.Row, "M") <> "" Then
    SAY = WorksheetFunction.CountIf(Columns(Target.Column), Target)
    If SAY > 1 Then
    Set BUL = Columns(Target.Column).Find(Target)
    If Not BUL Is Nothing Then
    ADRES = BUL.Address
    Do
    If Cells(Target.Row, "G") = Cells(BUL.Row, "G") And Cells(Target.Row, "I") = Cells(BUL.Row, "I") And Cells(Target.Row, "J") = Cells(BUL.Row, "J") And Cells(Target.Row, "M") = Cells(BUL.Row, "M") Then
    SATIR = IIf(SATIR = "", BUL.Row & Space(1), SATIR & ", " & BUL.Row & Space(1))
    End If
    Set BUL = Columns(Target.Column).FindNext(BUL)
    Loop While Not BUL Is Nothing And BUL.Address <> ADRES
    GoTo UYARI
    End If: End If: End If
    GoTo SON
UYARI: ONAY = MsgBox("Bu kay&#305;t daha &#246;nce a&#351;a&#287;&#305;daki sat&#305;rlarda girilmi&#351;tir !" & Chr(10) & Chr(10) & SATIR & Chr(10) & Chr(10) & "&#304;&#351;leme devam etmek istiyor musunuz?", vbYesNo + vbCritical, "D&#304;KKAT !")
    If ONAY = vbNo Then
    Cells(Target.Row, "G") = ""
    Cells(Target.Row, "I") = ""
    Cells(Target.Row, "J") = ""
    Cells(Target.Row, "M") = ""
    Target.Select
    Exit Sub: End If
    Target.Offset(1, 0).Select
SON:
End Sub

 

[Eser Gökay]

sayın COST_CONTROL tam istedigim gibi. ilginize tesekkur ediyorum. emeginize saglık. inanın hep soru soran olmak cok da hosnut oldugumuz bir durum degil, ama bizler de ogrenecez. ilgi ve sabriniza tekrar tesekkur ediyorum.

 

[ozsah]

Değerli dostlar çalışmanız süper hiç aklımda olmayan bir yaklaşıma götürdünüz beni fakat dosyama makronuzu uyarladığımda bir sorunlakarşılaşıyorum ilgilenirseniz sevinirim.

 

[cyber3]

tesekkurler