Aynı Hücrelerin Karşılarındaki Verileri Listeleme.

[hilmi0707]

Arkadaşlar Kolay gelsin. Ekteki dosyada da belirttiğimiz gibi aynı hücrenin karşısındaki verileri listelemek istiyoruz. Teşekkürler

 

[Orion1]

Arkadaşlar Kolay gelsin. Ekteki dosyada da belirttiğimiz gibi aynı hücrenin karşısındaki verileri listelemek istiyoruz. Teşekkürler

Dosyalarınız 2003 formatında yüklerseniz daha hızlı yanıt alabilirsiniz.
Çoğu kişi 2007 ye pek kolay kolay geçmek istemiyor.Bende öyle.

 

[İhsan Tank]

Arkadaşlar Kolay gelsin. Ekteki dosyada da belirttiğimiz gibi aynı hücrenin karşısındaki verileri listelemek istiyoruz. Teşekkürler

merhaba
istediğinizin bir kısmını yaptım ayrıca dosyanızı 2003 formatında yüklüyorum alternatif çözümler oluşması için

 

[Orion1]

Dosyanız ektedir.
Ayrıca Kenarlıklar için ilgili alana koşullu biçimlendirme yapıldı.

Sub aktar_59()
Dim sh As Worksheet, sat1 As Long, sat2 As Long, k As Range, adr As String
Dim i As Long
Set sh = Sheets("Sayfa1")
sat1 = sh.Cells(65536, "E").End(xlUp).Row
sat2 = 3
Sheets("Liste").Select
Range("B3.E65536").ClearContents
Application.ScreenUpdating = False
For i = 3 To sat1
    If WorksheetFunction.CountIf(sh.Range("E3:E" & i), sh.Cells(i, "E").Value) = 1 Then
        Set k = sh.Range("E3:E" & sat1).Find(sh.Cells(i, "E").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            adr = k.Address
            Cells(sat2, "B").Value = k.Value
            Do
                Cells(sat2, "C").Value = sh.Cells(k.Row, "B").Value
                Cells(sat2, "D").Value = sh.Cells(k.Row, "C").Value
                Cells(sat2, "E").Value = sh.Cells(k.Row, "D").Value
                sat2 = sat2 + 1
                Set k = sh.Range("E3:E" & sat1).FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adr
        End If
        sat2 = sat2 + 1
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[hilmi0707]

Evren Gizlen ve İhsan Tank Hocam,
Çok teşekkür ederim sizlere. Allah RAzı OLsun
Uzun zamandır internetten mahrumdum. Geç cevap yazabildim. kusura bakmayın

 

[İhsan Tank]

Evren Gizlen ve İhsan Tank Hocam,
Çok teşekkür ederim sizlere. Allah RAzı OLsun
Uzun zamandır internetten mahrumdum. Geç cevap yazabildim. kusura bakmayın

rica ederim
iyi çalışmalar :mutlu: