Ders Programını Başka Sayfada Süzme

[zerali]

Arkadaşlar aradım ama nasıl bir yapı kullanacağımı bir türlü kestiremedim.
Ekteki dosyamda veri sayfasında öğretmenlerin hangi gün hangi sınıfa derse gireceklerini belirten liste var. Diğer çalışma sayfasında metin kutusuna veya hücreye yazdığımda bana 3. saat hangi öğretmenlerin hangi sınıfta olduğunu görmek istiyorum.

Ör. Çarşamba 3. saat

x hocası 9-A
t hocası 9-B
...
k hocası 12-L

 

[Emir Hüseyin Çoban]

. . .

Veri sayfanız sabit bu şekilde mi.

Orjinal tablonuzda daha farklıysa, buna göre önerilen çözümler onda çalışmayabilir.

. . .

 

[YUSUF44]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz. yalnız öncesinde Sayfa3'te B2 hücresinin biçimini isteğe uyarlanmıştan 0". saat" ya da Genel yapmanız gerekmektedir:

Sub ders()
eski = Sheets("Sayfa3").Cells(Rows.Count, 1).End(3).Row
uyarı = MsgBox("Sayfa3'teki eski veriler silinecek, emin misiniz?", vbYesNo)
If uyarı = vbYes Then
Sheets("Sayfa3").Range("A5:B" & eski).ClearContents

son = Sheets("veri").Cells(Rows.Count, 1).End(3).Row
'gün = WorksheetFunction.Lookup(Sheets("Sayfa3").[a2], ["Cuma","Çarşamba","Pazartesi","Perşembe","Salı";5,3,1,4,2]) * 10 + Sheets("Sayfa3").[B2]
If Sheets("Sayfa3").[A2] = "Pazartesi" Then gün = 1 + Sheets("Sayfa3").[b2]
If Sheets("Sayfa3").[A2] = "Salı" Then gün = 11 + Sheets("Sayfa3").[b2]
If Sheets("Sayfa3").[A2] = "Çarşamba" Then gün = 21 + Sheets("Sayfa3").[b2]
If Sheets("Sayfa3").[A2] = "Perşembe" Then gün = 31 + Sheets("Sayfa3").[b2]
If Sheets("Sayfa3").[A2] = "Cuma" Then gün = 41 + Sheets("Sayfa3").[b2]

[e1] = son
[f1] = gün
For i = 3 To son
If Sheets("veri").Cells(i, gün) <> "" Then
yeni = WorksheetFunction.Max(5, Sheets("Sayfa3").Cells(Rows.Count, 1).End(3).Row + 1)
Sheets("Sayfa3").Cells(yeni, 1) = Sheets("veri").Cells(i, 1)
Sheets("Sayfa3").Cells(yeni, 2) = Sheets("veri").Cells(i, gün)
End If
Next
End If
        
End Sub

 

[catalinastrap]

Pivot İle çözümünüde ben ekliyorum

 

[zerali]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz. yalnız öncesinde Sayfa3'te B2 hücresinin biçimini isteğe uyarlanmıştan 0". saat" ya da Genel yapmanız gerekmektedir:

[/CODE]

denedim ekte ama eksik bilgimden dolayı hata verdi.

. . .

Veri sayfanız sabit bu şekilde mi.

Orjinal tablonuzda daha farklıysa, buna göre önerilen çözümler onda çalışmayabilir.

. . .

evet veri sayfası sabit. diğer sayfadan da rapor almak istiyorum hangi saatte hangi hocalar olacak diye.

 

[YUSUF44]

Dün hazırladığım dosya ektedir.

 

[muygun]

Merhaba;
Konu çözümlenmiş ama alternatif olsun.
İnceleyin.
İyi çalışmalar.

 

[zerali]

üstadlar çok teşekkürler, çözümleriniz çok işimize yarayacak. @YUSUF44, @muygun hocalarımm yazdırdığımız değerleri sınıfa göre sıralı bir şekilde vermesi için nasıl bir kod eklemeliyiz?

 

[muygun]

Merhaba;
İstediğiniz sütuna göre artan yada azalan sıralama yapabileceğiniz eki deneyin.
İyi çalışmalar.

 

[zerali]

Dün hazırladığım dosya ektedir.

iki örnek için ayrı ayrı teşekkür ederim.
YUSUF44 hocanın dosyasına muygun hocanın toggle'unu ekledim.
Ancak sorum şu ki tek butonda bunu halledebilir miyim. Toggle olmadan, sadece sınıf sıralamasını artan olarak görsem. Bir de 9. sınıfların şubelerini neden sona atıyor?

 

[YUSUF44]

Aşağıdaki makroyu kullanabilirsiniz. Ancak makronun çalışabilmesi için öncelikle listelemenin olduğu sayfada yani Sayfa3'te B3 hücresine Artan ya da Azalan yazmalısınız. Bunun için bu hücreye veri doğrulama uygulamanızı öneririm. Hatta A2 hücresine günler için ve B2 hücresine ders saati için de veri doğrulama yapmanız daha iyi olur. Veri doğrulama yaparken Liste'yi seçin ve alttaki boşluğa örneğin B3 hücresi için yapıyorsanız Artan;Azalan yazın. Makro çalışırken C ve D sütunlarını yardımcı olarak kullanıp formülleri uygular, sıralama bitince bu sütunlardaki verileri siler.

Sub ders()
eski = Sheets("Sayfa3").Cells(Rows.Count, 1).End(3).Row
uyarı = MsgBox("Sayfa3'teki eski veriler silinecek, emin misiniz?", vbYesNo)
If uyarı = vbYes Then
Sheets("Sayfa3").Range("A5:B" & eski).ClearContents

son = Sheets("veri").Cells(Rows.Count, 1).End(3).Row

If Sheets("Sayfa3").[A2] = "Pazartesi" Then gün = 1 + Sheets("Sayfa3").[b2]
If Sheets("Sayfa3").[A2] = "Salı" Then gün = 11 + Sheets("Sayfa3").[b2]
If Sheets("Sayfa3").[A2] = "Çarşamba" Then gün = 21 + Sheets("Sayfa3").[b2]
If Sheets("Sayfa3").[A2] = "Perşembe" Then gün = 31 + Sheets("Sayfa3").[b2]
If Sheets("Sayfa3").[A2] = "Cuma" Then gün = 41 + Sheets("Sayfa3").[b2]

For i = 3 To son
If Sheets("veri").Cells(i, gün) <> "" Then
yeni = WorksheetFunction.Max(5, Sheets("Sayfa3").Cells(Rows.Count, 1).End(3).Row + 1)
Sheets("Sayfa3").Cells(yeni, 1) = Sheets("veri").Cells(i, 1)
Sheets("Sayfa3").Cells(yeni, 2) = Sheets("veri").Cells(i, gün)
End If
Next
End If

[C4] = "Sınıf"
[D4] = "Şube"
enson = Cells(Rows.Count, 1).End(3).Row
Range("D5").FormulaR1C1 = "=RIGHT(RC[-2],1)"
Range("C5").FormulaR1C1 = "=SUBSTITUTE(RC[-1],RC[1],"""")*1"
    Range("C5:D5").Select
    Selection.AutoFill Destination:=Range("C5:D" & enson)
    Range("A4:D" & enson).Select
    ActiveWorkbook.Worksheets("Sayfa3").Sort.SortFields.Clear
If [b3] = "Azalan" Then
    ActiveWorkbook.Worksheets("Sayfa3").Sort.SortFields.Add Key:=Range("C5:C" & enson) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sayfa3").Sort.SortFields.Add Key:=Range("D5:D" & enson) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sayfa3").Sort
        .SetRange Range("A4:D" & enson)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Else
If [b3] = "Artan" Then
    ActiveWorkbook.Worksheets("Sayfa3").Sort.SortFields.Add Key:=Range("C5:C" & enson) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sayfa3").Sort.SortFields.Add Key:=Range("D5:D" & enson) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sayfa3").Sort
        .SetRange Range("A4:D" & enson)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End If
End If
Range("C4:D" & enson).ClearContents
[A3].Select
End Sub

 

[zerali]

çok teşekkürler yusuf44 hocam çok sağolun