İNDİS ve KAÇINCI ile çözemediğim bir listeleme sorunu.

[cem116]

Merhaba üstadlar, aşağıda linkini paylaştığım dosyada bir etüt dosyası oluşturmaya çalıştım. Bir sayfada ilgili derslerin öğretmenleri ders saatleri ve derslikleri var, ikinci sayfa ise liste sayfası. Dosyanın "liste" sayfasında daha detaylı biçimde de anlatmaya çalıştığım gibi ilk sayfada yatay olarak bir tabloda toplu halde bulunan verilerin benim istediğim düzende ikinci sayfada listelenmesini istiyorum. Ben bildiğim yöntemler üzerinden bir şeyler denedim ama takılıp kaldım ve ilerleyemedim. O nedenle direkt sorunumu dosya yükleyerek bir bilene danışmak istedim. Makro ya da formül her türlü çözüme açığım, yardımlarınız için şimdiden teşekkürler.

https://www.dosyaupload.com/74m3

yardımlarınız için şimdiden çok teşekkürler...

 

[Erdem Akdemir]

Site üzerinden de dosyayı yükleyebilir misiniz.

 

[YUSUF44]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz. Verilerin çokluğuna göre uzun sürebilir:

Sub etutler()
Set s1 = Sheets("ETÜT")
Set s2 = Sheets("LİSTE")
Application.ScreenUpdating = False
eski = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)
sonA = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)
s2.Range("A2:C" & eski).ClearContents

For koridor = 2 To sonA Step 12
    sonsut = s1.Cells(koridor, Columns.Count).End(xlToLeft).Column
    For salon = 2 To sonsut
        For ogrenci = koridor + 2 To koridor + 11
            If s1.Cells(ogrenci, salon) <> "" Then
                yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
                s2.Cells(yeni, "A") = s1.Cells(koridor, salon)
                s2.Cells(yeni, "B") = s1.Cells(koridor + 1, salon)
                s2.Cells(yeni, "C") = s1.Cells(ogrenci, salon)
            End If
        Next
    Next
Next
Application.ScreenUpdating = True
s2.Activate
MsgBox "İşlem tamamlandı"
End Sub

 

[cem116]

Site üzerinden de dosyayı yükleyebilir misiniz.

Merhaba, öncelikle ilginiz için teşekkürler. Yükledim şimdi.

 

[cem116]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz. Verilerin çokluğuna göre uzun sürebilir:

Sub etutler()
Set s1 = Sheets("ETÜT")
Set s2 = Sheets("LİSTE")
Application.ScreenUpdating = False
eski = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)
sonA = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)
s2.Range("A2:C" & eski).ClearContents

For koridor = 2 To sonA Step 12
    sonsut = s1.Cells(koridor, Columns.Count).End(xlToLeft).Column
    For salon = 2 To sonsut
        For ogrenci = koridor + 2 To koridor + 11
            If s1.Cells(ogrenci, salon) <> "" Then
                yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
                s2.Cells(yeni, "A") = s1.Cells(koridor, salon)
                s2.Cells(yeni, "B") = s1.Cells(koridor + 1, salon)
                s2.Cells(yeni, "C") = s1.Cells(ogrenci, salon)
            End If
        Next
    Next
Next
Application.ScreenUpdating = True
s2.Activate
MsgBox "İşlem tamamlandı"
End Sub

Üstad, şimdi hemen deneyip durumu bildireceğim. Teşekkür ederim ilginiz için

 

[cem116]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz. Verilerin çokluğuna göre uzun sürebilir:

Sub etutler()
Set s1 = Sheets("ETÜT")
Set s2 = Sheets("LİSTE")
Application.ScreenUpdating = False
eski = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)
sonA = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)
s2.Range("A2:C" & eski).ClearContents

For koridor = 2 To sonA Step 12
    sonsut = s1.Cells(koridor, Columns.Count).End(xlToLeft).Column
    For salon = 2 To sonsut
        For ogrenci = koridor + 2 To koridor + 11
            If s1.Cells(ogrenci, salon) <> "" Then
                yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
                s2.Cells(yeni, "A") = s1.Cells(koridor, salon)
                s2.Cells(yeni, "B") = s1.Cells(koridor + 1, salon)
                s2.Cells(yeni, "C") = s1.Cells(ogrenci, salon)
            End If
        Next
    Next
Next
Application.ScreenUpdating = True
s2.Activate
MsgBox "İşlem tamamlandı"
End Sub

Üstad gayet güzel çalışıyor kod. Birkaç kez farklı biçimde denedim bir hata almadım. Ellerinize sağlık. Kod kısmı benim biraz uzak olduğum bir kısım yani kodlara bakarak da pek anlamıyorum maalesef tam olarak ne olduğunu Ama iş gördüğü muhakkak. Teşekkür ederim desteğiniz için. Formüllü bir çözüm de gelirse en azından onun çalışma mantığını öğrenir, benzer işlerde kendim çözebilirim diye ümit ediyorum. Olmazsa da bu kodu başka durumlarda nasıl kullanabilirim, biraz inceleyip çözmeye çalışacağım. Ellerinize sağlık tekrar.

 

[YUSUF44]

Üstad gayet güzel çalışıyor kod. Birkaç kez farklı biçimde denedim bir hata almadım. Ellerinize sağlık. Kod kısmı benim biraz uzak olduğum bir kısım yani kodlara bakarak da pek anlamıyorum maalesef tam olarak ne olduğunu Ama iş gördüğü muhakkak. Teşekkür ederim desteğiniz için. Formüllü bir çözüm de gelirse en azından onun çalışma mantığını öğrenir, benzer işlerde kendim çözebilirim diye ümit ediyorum. Olmazsa da bu kodu başka durumlarda nasıl kullanabilirim, biraz inceleyip çözmeye çalışacağım. Ellerinize sağlık tekrar.

Yavaş yavaş kod kısmına başlayabilirsiniz o zaman. Gözünüzü korkutmayın. Ben de ve hatta bu sitedeki çoğu üstad da muhtemelen bir zamanlar sizin gibiydi.

Sorununuz formülle nasıl çözülür ben bilmiyorum. Çözülemez de diyemiyorum ama dosyanızın yapısı itibarıyla tek formülle çözülmesi çok zor.

 

[cem116]

Yavaş yavaş kod kısmına başlayabilirsiniz o zaman. Gözünüzü korkutmayın. Ben de ve hatta bu sitedeki çoğu üstad da muhtemelen bir zamanlar sizin gibiydi.

Sorununuz formülle nasıl çözülür ben bilmiyorum. Çözülemez de diyemiyorum ama dosyanızın yapısı itibarıyla tek formülle çözülmesi çok zor.

Aslında ben de kod işine bulaşmak istiyorum. Ama şöyle sıfırdan başlayıp adım adım anlatan bir videolu anlatım lazım. Youtube da var beğendiğim birkaç kanal, oralardan böyle merak ettiklerimi filan takip ediyorum ama kod işi biraz ayrı. Çabuk öğrenirim ve sürekli bir şeyler denerim aslında. Ama işte bi başlamak lazım bir yerden Bu konuda önerileriniz olursa çok da memnun olurum bu arada.Desteğiniz için tekrar teşekkür ederim.