aynı isimleri bulup listeleme

[@hmet]

mrb arkadaşlar çok acill ) yardımlarınız için şimdiden tşk.

 

[ozgretmen]

Aşağıdaki adresi bir inceler misiniz ?
http://www.excel.web.tr/f14/iki-sutundaki-benzer-olanlari-bulma-t60279.html

 

[ozgretmen]

Sorunuzun ilk kısmı tamam.iyi çalışmalar.

 

[ozgretmen]

Sorunuza kendimce cevap buldum.Umarım işinize yarar.iyi çalışmalar...

 

[muygun]

Slm.
İşlevlerle bir çözümde benden.
İyi çalışmalar.

 

[Necdet]

Merhaba,
Yanıtlamakta gecikmişim ama, değişik yaklaşım olsun.

Aşağıdaki kodları üretirken şunu düşündüm :

• Bir personel 1 den fazla avans alabilir.
• 1 den fazla avans aldığında Avanslar Toplanır.
• Personel Numarası ile Personel Adı aynı ise Maaş sütununun yanındaki Avans sütununda gösterilir.
• Numara aynı ama isim değişik ise farklı sütunda gösterilir.
• Avans alan kişinin numarası Maaş alanın numarasında yoksa Ayrı gösterildiği gibi ayrıca Kırmızı ile gösterilir.
• Tüm bunlar Sayfa2 de gösterilir.

Sub Duzenle()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim i, j, Son As Long
Dim c As Range
j = 1
Application.ScreenUpdating = False
s2.Range("A2:I65536").ClearContents
s2.Range("A2:I65536").Interior.ColorIndex = xlNone
Son = s1.[A65536].End(3).Row
s1.Range("A2:C" & Son).Copy s2.[A2]
For i = 2 To s1.[E65536].End(3).Row
    With s2.Range("A2:A" & Son)
        Set c = .Find(s1.Cells(i, "E"), LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            If s1.Cells(i, "F") = s2.Cells(c.Row, "B") Then
                s2.Cells(c.Row, "D") = s2.Cells(c.Row, "D") + s1.Cells(i, "G")
            Else
                j = j + 1
                s1.Range(s1.Cells(i, "E"), s1.Cells(i, "G")).Copy s2.Range("F" & j)
            End If
        Else
            j = j + 1
            s1.Range(s1.Cells(i, "E"), s1.Cells(i, "G")).Copy s2.Range("F" & j)
            s2.Range("F" & j & ":H" & j).Interior.ColorIndex = 3
        End If
    End With
Next i
End Sub

 

[Ali]

Buda farklı bir örnek olsun.

 

[@hmet]

hepinize ayrı ayrı tşk her daim var olun)