Birden Fazla satırda tekrar eden isimler

[nurluali]

Burada Kasım Ayında Hangi Tarihlerde devamsızlık yapmış ise o kadar satırda isim geçiyor. Sayfa2 ye örenkte olduğu gibi listelemek istiyorum. nasıl bir formül kullanmam gerekir. Bu Liste bu şekilde 200 300 satır uzuyor.

 

[YUSUF44]

Formülle nasıl olur bilmiyorum. Makro isterseniz aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub devam()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son1 = s1.Cells(Rows.Count, "B").End(3).Row
eski = WorksheetFunction.Max(s2.Cells(Rows.Count, "B").End(3).Row, 2)
uyar = MsgBox("Eski veriler silinsin mi?", vbYesNo)
If uyar = vbYes Then
    s2.Range("B3:BB" & eski).ClearContents
    s2.Range("B3:BB" & eski).Interior.Color = xlNone
    s2.Range("B3:BB" & eski).Borders.LineStyle = xlNone

    s1.Range("B3:B" & son1).Copy s2.[B2]
    
    s2.Range("B2:B" & son1).RemoveDuplicates Columns:=1, Header:=xlNo
    son2 = s2.Cells(Rows.Count, "B").End(3).Row
    For kisi = 2 To son2
        For gun = 3 To son1
            If s1.Cells(gun, "B") = s1.Cells(kisi, "B") Then
                yeni = s2.Cells(kisi, Columns.Count).End(xlToLeft).Column + 1
                s2.Cells(kisi, yeni) = s1.Cells(gun, "C")
                s2.Cells(kisi, yeni).Interior.Color = s2.Cells(kisi, "B").Interior.Color
                s2.Cells(kisi, yeni).NumberFormat = "dd/mm/yyyy"
                s2.Cells(kisi, yeni).HorizontalAlignment = xlCenter
                s2.Cells(kisi, yeni).VerticalAlignment = xlCenter
            End If
        Next
    Next
End If
End Sub

 

[Korhan Ayhan]

Formülle alternatif;

DİZİ formüllerdir. Formülü hücreye yazdıkta sonra hücreyi CTRL+SHIFT+ENTER tuşlarına basarak terk ediniz. Aksi halde doğru sonuç üretmez.

B2;

=EĞERHATA(İNDİS(Sayfa1!$B$3:$B$1000;KAÇINCI(KÜÇÜK(EĞER(EĞERSAY($B$1:B1;Sayfa1!$B$3:$B$1000&"")=0;EĞERSAY(Sayfa1!$B$3:$B$1000;"<"&Sayfa1!$B$3:$B$1000);"");1);EĞERSAY(Sayfa1!$B$3:$B$1000;"<"&Sayfa1!$B$3:$B$1000);0));"")

C2;

=EĞERHATA(İNDİS(Sayfa1!$C$3:$C$1000;KÜÇÜK(EĞER(Sayfa1!$B$3:$B$1000=$B2;EĞER(Sayfa1!$C$3:$C$1000<>"";SATIR(Sayfa1!$C$3:$C$1000)-2));SÜTUN(A$1)));"")

Bu formülleri ihtiyacınız kadar alta ve yana sürükleyiniz.

 

[EmrExcel16]

Alternatif .
Dizi formülüdür ( CTRL+SHIFT+ENTER tuşlarına basarak tamamlayınız formülü )
Aşağıya ve sağa doğru çekiniz.

=EĞERHATA(EĞER(B2="";"";İNDİS(Sayfa1!$C$3:$C$1000;KÜÇÜK(EĞER(Sayfa1!$B$3:$B$1000=KIRP($B2);SATIR(Sayfa1!$C$3:$C$1000));SÜTUNSAY($A$2:A$2))));"")

 

[YUSUF44]

Kodda bazı hatalar vardı, düzelttim:

Sub devam()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son1 = s1.Cells(Rows.Count, "B").End(3).Row
eski = WorksheetFunction.Max(s2.Cells(Rows.Count, "B").End(3).Row, 2)
uyar = MsgBox("Eski veriler silinsin mi?", vbYesNo)
If uyar = vbYes Then
    s2.Range("B2:BB" & eski).ClearContents
    s2.Range("B2:BB" & eski).Interior.Color = xlNone
    s2.Range("B2:BB" & eski).Borders.LineStyle = xlNone

    s1.Range("B3:B" & son1).Copy s2.[B2]
    
    s2.Range("B2:B" & son1).RemoveDuplicates Columns:=1, Header:=xlNo
    son2 = s2.Cells(Rows.Count, "B").End(3).Row
    For kisi = 2 To son2
        For gun = 3 To son1
            If s1.Cells(gun, "B") = s2.Cells(kisi, "B") Then
                yeni = s2.Cells(kisi, Columns.Count).End(xlToLeft).Column + 1
                s2.Cells(kisi, yeni) = s1.Cells(gun, "C")
                s2.Cells(kisi, yeni).Interior.Color = s2.Cells(kisi, "B").Interior.Color
                s2.Cells(kisi, yeni).NumberFormat = "dd/mm/yyyy"
                s2.Cells(kisi, yeni).HorizontalAlignment = xlCenter
                s2.Cells(kisi, yeni).VerticalAlignment = xlCenter
            End If
        Next
    Next
End If
End Sub

 

[nurluali]

Kodda bazı hatalar vardı, düzelttim:

Sub devam()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son1 = s1.Cells(Rows.Count, "B").End(3).Row
eski = WorksheetFunction.Max(s2.Cells(Rows.Count, "B").End(3).Row, 2)
uyar = MsgBox("Eski veriler silinsin mi?", vbYesNo)
If uyar = vbYes Then
    s2.Range("B2:BB" & eski).ClearContents
    s2.Range("B2:BB" & eski).Interior.Color = xlNone
    s2.Range("B2:BB" & eski).Borders.LineStyle = xlNone

    s1.Range("B3:B" & son1).Copy s2.[B2]
   
    s2.Range("B2:B" & son1).RemoveDuplicates Columns:=1, Header:=xlNo
    son2 = s2.Cells(Rows.Count, "B").End(3).Row
    For kisi = 2 To son2
        For gun = 3 To son1
            If s1.Cells(gun, "B") = s2.Cells(kisi, "B") Then
                yeni = s2.Cells(kisi, Columns.Count).End(xlToLeft).Column + 1
                s2.Cells(kisi, yeni) = s1.Cells(gun, "C")
                s2.Cells(kisi, yeni).Interior.Color = s2.Cells(kisi, "B").Interior.Color
                s2.Cells(kisi, yeni).NumberFormat = "dd/mm/yyyy"
                s2.Cells(kisi, yeni).HorizontalAlignment = xlCenter
                s2.Cells(kisi, yeni).VerticalAlignment = xlCenter
            End If
        Next
    Next
End If
End Sub

sayın YUSUF44 ilginize ve emeğiniz için çok teşekkür ediyorum. Tam istediğim gibi oldu. Elinize beyninize sağlık.

 

[nurluali]

Alternatif .
Dizi formülüdür ( CTRL+SHIFT+ENTER tuşlarına basarak tamamlayınız formülü )
Aşağıya ve sağa doğru çekiniz.

=EĞERHATA(EĞER(B2="";"";İNDİS(Sayfa1!$C$3:$C$1000;KÜÇÜK(EĞER(Sayfa1!$B$3:$B$1000=KIRP($B2);SATIR(Sayfa1!$C$3:$C$1000));SÜTUNSAY($A$2:A$2))));"")

Sayın EmrExcel16 ilginize çok teşekkür ediyorum. formül çalıştı fakat devamsızlık tarihleri başka öğrencinin devamsızlığı geliyor. Tekrar deneyip size döneceğim. Sağolun var olun

 

[nurluali]

Formülle alternatif;

DİZİ formüllerdir. Formülü hücreye yazdıkta sonra hücreyi CTRL+SHIFT+ENTER tuşlarına basarak terk ediniz. Aksi halde doğru sonuç üretmez.

B2;

=EĞERHATA(İNDİS(Sayfa1!$B$3:$B$1000;KAÇINCI(KÜÇÜK(EĞER(EĞERSAY($B$1:B1;Sayfa1!$B$3:$B$1000&"")=0;EĞERSAY(Sayfa1!$B$3:$B$1000;"<"&Sayfa1!$B$3:$B$1000);"");1);EĞERSAY(Sayfa1!$B$3:$B$1000;"<"&Sayfa1!$B$3:$B$1000);0));"")

C2;

=EĞERHATA(İNDİS(Sayfa1!$C$3:$C$1000;KÜÇÜK(EĞER(Sayfa1!$B$3:$B$1000=$B2;EĞER(Sayfa1!$C$3:$C$1000<>"";SATIR(Sayfa1!$C$3:$C$1000)-2));SÜTUN(A$1)));"")

Bu formülleri ihtiyacınız kadar alta ve yana sürükleyiniz.

Sayın Korhan Ayhan bey emeğinize ve elinize sağlık yapmak istediğim gibi olmuş. Tekrar çok teşekkür eder saygılar sunarım.