aynı olanları bulma ve kontrol

[baba_karabatak]

ekte göndermiş olduğum dosyada görüleceği üzere aynı adı soyadı olan kişinin baba ismi "aynı ad ve soyada sahip olupda baba ismi farklı olanında baba ismini" bana göstermesini ve tamam kısmını okeylemesi. şimdiden yardımlar için teşekkürler:yardim:

 

[Levent Menteşoğlu]

Lütfen dosyanızda gerçek veriler kullanmayın, bu sebeple dosyanızı kaldırdım. Verileri gerçek olmayanlarla değiştirerek yeniden ekleyiniz. (en azından TC kimlik nolar)

 

[Korhan Ayhan]

Selamlar,

Örnek dosyanıza göre aşağıdaki işlemleri yapınız.

KİMLİK sayfası O2 hücresine aşağıdaki formülü yazıp aşağıya doğru kopyalayın.

=B2&" "&C2

DOĞANLAR_MALİK LİSTESİ sayfası F2 hücresine aşağıdaki formülü yazıp aşağıya doğru kopyalayın.

=EĞER(C2="";"";EĞER(TOPLA.ÇARPIM((KİMLİK!$O$2:$O$5000=C2)*(KİMLİK!$D$2:$D$5000=D2))>0;"X";""))

Yine aynı sayfanın kod bölümüne aşağıdaki kodu uygulayıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
    If WorksheetFunction.CountIf(Range("C2:C" & Target.Row - 1), Target) > 0 Then
    MsgBox "BABA ADI : " & Range("C2:C" & Target.Row - 1).Find(WHAT:=Target, LookAt:=xlWhole).Offset(0, 1).Value
    Else
    End If
End Sub

 

[baba_karabatak]

Teşekkür ama tam olarak işimi görmedi doyayı birdaha gönderiyorum ne demek istediğimi herhalde daha net ifade ettiğimi sanıyorum.

 

[baba_karabatak]

yardımlarınızı bekliyorum

tam olarak anlatamadım herhalde derdimi dosyada bu sefer tam olarak ifade etmişimdir inşallah şimdiden yardımlarınız için teşekkürler

 

[Korhan Ayhan]

Selamlar,

Sayfanın kod bölümündeki kodları silip aşağıdaki kodu uygulayıp denermisiniz. Ayrıca dosyanızın ilk formatına göre formülü düzenlemiştim şimdi TC kimlik nolar sildiğiniz için formül çalışmıyor. Eğer dosyanızı bu şekilde kullanacaksanız. Formülün sonundaki "D" harflerini "C" olarak değiştirin. Umarım faydası olur.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
    If WorksheetFunction.CountIf(Range("C2:C" & Target.Row - 1), Target) > 0 Then
    For Each ALAN In Range("C2:C" & Target.Row - 1)
    If ALAN.Value = Target Then
    If MESAJ = "" Then
    MESAJ = ALAN.Offset(0, 1).Value
    Else
    MESAJ = MESAJ & vbCrLf & ALAN.Offset(0, 1).Value
    End If: End If
    Next
    MsgBox MESAJ, vbExclamation, "BABA İSİMLERİ"
    End If
End Sub

 

[baba_karabatak]

çok teşekkürler COST CONTROL bu işimi görür bir ricada daha bulunsam aynı baba adını 1 kez yazmasını istediğimde for next döngüsümü kurmalıyım yoksa başka yolu varmı