Farklı Sütundaki seçim yapılanları listeleme

[vein03051976]

Merhabalar

Ekteki tabloda Kulüp seçimi yapan öğrencilerin listesi vardır.

Ama her öğrenci aynı kulübü farklı sütunlarda seçim yapabiliyor.

Dolayısı ile Hangi kulübe kaç öğrenci katılacak listesini yapmak çok zor.

"Seçim" tablosunu "Liste" tablosu haline getirmenin bir yolu var mıdır?

Not: Özel bilgileri kaldırdım ama satırdaki öğrenci bilgilerinin tamamı gelmesi gerekiyor

 

[vein03051976]

Yardımcı Olabilecek kimse yok mu :-(

 

[Tevfik_Kursun]

Merhaba Arkadaşım,
Hazırladığımı inceleyip kendinize uyarlayın.
iyi çalışmalar

 

[veyselemre]

Sub test()
    
    With Sheets("seçim")
        son = .Cells(Rows.Count, 3).End(3).Row

        veri = .Range("A2:S" & son).Value
    End With
    
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(veri)
            For ii = 7 To 19
                If veri(i, ii) <> "" Then
                    krt = veri(i, ii)
                    If Not .exists(krt) Then
                        .Item(krt) = i
                    Else
                        .Item(krt) = .Item(krt) & "," & i
                    End If
                End If
            Next ii
        Next i
        kys = .keys
        itms = .items

    End With
    
    sat = 2
    With Sheets("Liste")
        .Range("A2:G" & Rows.Count).ClearContents
        For i = LBound(itms) To UBound(itms)
            For Each b In Split(itms(i), ",")
                .Cells(sat, 1).Value = kys(i)
                .Cells(sat, 2).Value = veri(b, 2)
                .Cells(sat, 3).Value = veri(b, 3)
                .Cells(sat, 4).Value = veri(b, 4)
                .Cells(sat, 5).Value = veri(b, 5)
                .Cells(sat, 6).Value = veri(b, 6)
                .Cells(sat, 7).Value = veri(b, 7)
                sat = sat + 1
            Next b
        Next i
    End With

End Sub

 

[vein03051976]

Merhaba

Tevfik_Kursun tablonuzu indirdim. Uyarlama yapacağım.

veyselemre'in attığı kod ile sonuca vardık.

Ellerinize sağlık Çok teşekkürler

 

[Tevfik_Kursun]

Rica ederim