• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

isime göre sıralama

  • Konbuyu başlatan Konbuyu başlatan zerali
  • Başlangıç tarihi Başlangıç tarihi

zerali

Altın Üye
Katılım
30 Ocak 2013
Mesajlar
422
Excel Vers. ve Dili
2010 türkçe
Arkadaşlar kitaplığımdaki öğrencileri ve okudukları kitapları gösteren tabloda öğrenci ismine göre aynı satırda x işareti konulan kitapları sıralaması mümkün müdür? Yardımlarınız için şimdiden teşekkürler
 

Ekli dosyalar

Merhaba,

ben sorunuzu tam olarak anlamadım. Aynı tabloda sıralama pek olası görünmüyor.
Başka bir sayfada mı sıralama istiyorsunuz.

Ya da olması gerekeni örnekleyiniz.
 
Necdet hocam kusuruma bakmayın okuldaki internetten cevap yazamadım imleç döndü durdu.İsimlere göre başka bir sayfada sıralanması olabilir
 
kitaplığımdaki öğrencileri ve okudukları kitapları gösteren tabloda öğrenci ismine göre aynı satırda x işareti konulan kitapları başka bir sayfada sıralamasını yapmak çok zor bir şey mi arkadaşlar. yardımlarınızı bekliyorum
 
Necdet hocam kusuruma bakmayın okuldaki internetten cevap yazamadım imleç döndü durdu.İsimlere göre başka bir sayfada sıralanması olabilir

Merhaba, ben de işyerindeki internette kısıtlama olduğu için verdiğiniz adrese ulaşıp bakamıyorum :)
 
Keşke örneğinizde nasıl bir sonuç istediğinizi de gösterseydiniz. Yani başka sayfada sıralama nasıl yapılacak? Sütunlarda öğrenci isimleri altlarında okudukları kitaplar mı yoksa satırlarda öğrenci isimleri yanda okudukları kitaplar mı?
 
Örneğin Aşağıdaki kodları bir modüle yapıştırıp denediğinizde "liste" sayfasına isimleri ve karşılarına okudukları kitapları getirir (Dosyanızda liste isimli bir sayfa oluşturunuz):

Kod:
Sub aktar()
Set s1 = Sheets("hikaye")
Set s2 = Sheets("liste")

sonsat = WorksheetFunction.Max(4, s1.Cells(Rows.Count, "B").End(3).Row)
sonsut = WorksheetFunction.Max(3, s1.Cells(3, Columns.Count).End(xlToLeft).Column)

eski = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)
s2.Rows("2:" & eski).ClearContents

yenikişi = 2
For kişi = 4 To sonsat
    yenikitap = 2
    If WorksheetFunction.CountIf(s1.Range(s1.Cells(kişi, "C"), s1.Cells(kişi, sonsut)), "X") > 0 Then
        s2.Cells(yenikişi, "A") = s1.Cells(kişi, "B")
        For kitap = 3 To sonsut
            If s1.Cells(kişi, kitap) = "X" Then
                s2.Cells(yenikişi, yenikitap) = s1.Cells(3, kitap)
                yenikitap = yenikitap + 1
            End If
        Next
        yenikişi = yenikişi + 1
    End If
Next

End Sub
 
Yusuf hocam makro dan pek anlamıyorum yapmak istediğim şey öğrencilerin karşılarındaki işaretli kitapların bir yerde listelenmesi bana liste lazım yardımcı olabilirseniz sevinirim
 

Ekli dosyalar

Sayfa1'in kod sayfasına kopyaladığınız kodları modüle almanız gerekiyor. Bunun için kod sayfasında Insert menüsü var, ordan Module'yi seçin ve kodları açılan sayfaya yapıştırın. bir de hikaye sayfasında küçük x kullanıldığı için ve makroda büyük X olarak değerlendirildiği için kitap listesi oluşmuyor. Bunun için koda çok küçük bir ilave yaptım:

Kod:
Sub aktar()
Set s1 = Sheets("hikaye")
Set s2 = Sheets("liste")

sonsat = WorksheetFunction.Max(4, s1.Cells(Rows.Count, "B").End(3).Row)
sonsut = WorksheetFunction.Max(3, s1.Cells(3, Columns.Count).End(xlToLeft).Column)

eski = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)
s2.Rows("2:" & eski).ClearContents

yenikişi = 2
For kişi = 4 To sonsat
    yenikitap = 2
    If WorksheetFunction.CountIf(s1.Range(s1.Cells(kişi, "C"), s1.Cells(kişi, sonsut)), "X") > 0 Then
        s2.Cells(yenikişi, "A") = s1.Cells(kişi, "B")
        For kitap = 3 To sonsut
            If [B]UCase([/B]s1.Cells(kişi, kitap)[B])[/B] = "X" Then
                s2.Cells(yenikişi, yenikitap) = s1.Cells(3, kitap)
                yenikitap = yenikitap + 1
            End If
        Next
        yenikişi = yenikişi + 1
    End If
Next

End Sub
 
çok teşekkürler Yusuf hocam yazdıklarınızı aynen yaptım ama aktarmadı. aktarma butonu da eklemem gerekiyor mu?
 
Tabi bir düğme ekleyip makroyu bu düğmeye atarsanız makroyu daha kolay çalıştırırsınız.
 
hocam buton ekleme işini en sade biçimde nasıl yapabilirim yönlendirme ya da tarif yapabilirmisiniz
 
Merhaba,

Bende bir şeyler yaptım.
Liste adında bir sayfa olması gerek.

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Öğrenci adı ve aldığı kitaplara göre sonucu listeler.

Kod:
Sub Listele()

    Dim i   As Long, _
        j   As Long, _
        k   As Integer, _
        m   As Integer, _
        ShH As Worksheet, _
        ShL As Worksheet
    
    Set ShH = Sheets("Hikaye")
    Set ShL = Sheets("Liste")
    
    k = ShH.Range("C3").End(xlToRight).Column
    j = 1
    Application.ScreenUpdating = False
    
    ShL.Range("A2:C" & Rows.Count).ClearContents
    
    For i = 4 To ShH.Cells(Rows.Count, "A").End(3).Row
        For m = 3 To k
            If Not ShH.Cells(i, m) = "" Then
                j = j + 1
                ShL.Cells(j, "A") = ShH.Cells(i, "A")
                ShL.Cells(j, "B") = ShH.Cells(i, "B")
                ShL.Cells(j, "C") = ShH.Cells(3, m)
            End If
        Next m
    Next i
    
    ShL.Range("A2:C" & j).Sort Key1:=ShL.Range("B1"), Key2:=ShL.Range("C1")
    
    Application.ScreenUpdating = True
    
    MsgBox "Aktarım ve Listeleme Tamamlanmıştır...", vbInformation
    
End Sub
 
Yardımlarınız için çok teşekkürler Necdet Hocam
 
Yardımlarınız için çok teşekkürler Yusuf44 hocam
 
Geri
Üst