Sınıflara ait Sınav Notlarını Getirme

[cimcoz]

Merhaba,

Ekteki dosyamda sütün yerleri sabit kalacak şekilde, Sınıflar sayfasındaki veriye göre, Karne sayfasından C1 listesinden seçilecek sınıfa ait ad soyad, sınav notları v.s. gibi tüm bilgilerin gelmesini istiyorum (boş hücrelerdekiler de gelmeli) . Vlookup ile getiriyorum ama liste çok büyük, satır/formül kopyalama v.s. yapınca dosya boyutu büyüyor ve ağırlaşıyor. Daha farklı bir yoldan yapabilirseniz çok sevinirim.

Bir de listedeki sınıf isimlerinin tekil gelmesi konusuda yardımlarınızı rica ederim.

Saygılarımla,

 

[Ömer]

Merhaba,

Karne sayfasının kod bölümüne kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Ss As Worksheet, sat As Long, c As Range, Adr As String
   
    If Intersect(Target, [C1]) Is Nothing Then Exit Sub
   
    Set Ss = Sheets("Siniflar")
   
    Application.ScreenUpdating = False
    Range("A3:AG" & Rows.Count).ClearContents
    If Target = "" Then Exit Sub

    sat = 3
    Set c = Ss.[B:B].Find(Target, , xlValues, xlWhole)
    If Not c Is Nothing Then
        Adr = c.Address
        Do
            Ss.Rows(c.Row).Copy Cells(sat, "A")
            sat = sat + 1
            Set c = Ss.[B:B].FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    End If

End Sub

 

[Ömer]

Veri doğrulama sorunuzu sonradan gördüm. Karne sayfasının kod bölümüne;
Sayfa aktif olduğunda çalışacağı için bir kereliğine diğer sayfaya girip karne sayfasına dönün.

Private Sub Worksheet_Activate()
   
    Dim i As Long, deg As String, d As Object, Ss As Worksheet
   
    Set d = CreateObject("Scripting.Dictionary")
    Set Ss = Sheets("Siniflar")
   
    For i = 3 To Ss.Cells(Rows.Count, "B").End(xlUp).Row
        deg = Ss.Cells(i, "B")
        If Not d.exists(deg) Then
            d.Add deg, Nothing
        End If
    Next i

    Range("C1").Validation.Delete
    Range("C1").Validation.Add Type:=xlValidateList, Formula1:=Join(d.keys, ",")
   
End Sub

 

[cimcoz]

Veri doğrulama sorunuzu sonradan gördüm. Karne sayfasının kod bölümüne;
Sayfa aktif olduğunda çalışacağı için bir kereliğine diğer sayfaya girip karne sayfasına dönün.

Private Sub Worksheet_Activate()
  
    Dim i As Long, deg As String, d As Object, Ss As Worksheet
  
    Set d = CreateObject("Scripting.Dictionary")
    Set Ss = Sheets("Siniflar")
  
    For i = 3 To Ss.Cells(Rows.Count, "B").End(xlUp).Row
        deg = Ss.Cells(i, "B")
        If Not d.exists(deg) Then
            d.Add deg, Nothing
        End If
    Next i

    Range("C1").Validation.Delete
    Range("C1").Validation.Add Type:=xlValidateList, Formula1:=Join(d.keys, ",")
  
End Sub

Sayın Ömer,

Ekte vb tarafına belirttiğiniz kodu ekledim.Ama hatalı eklemiş olabilirim zira çalışmadı. Dosya üzerinde gerekli düzelmeyi yapıp, ekli olarak yollayabilirseniz çok sevinirim.

Saygılarımla,

 

[Ömer]

Module değil karne sayfasının kod bölümüne eklemeniz gerekiyordur.
Dosyanız ektedir.

 

[cimcoz]

Module değil karne sayfasının kod bölümüne eklemeniz gerekiyordur.
Dosyanız ektedir.

Sayın Ömer,

Çok teşekkür ederim çalıştı. Yalnız Sınıflar sayfasına gitmek istediğimde her seferinde ekteki hatayı alıyorum. Bunu nasıl aşabilirim?



Saygılarımla,

 

[Ömer]

Merhaba,

İşletim sisteminiz Mac mi?

 

[cimcoz]

Merhaba,

İşletim sisteminiz Mac mi?

Doğrudur.

 

[Ömer]

Deneyiniz.

 

[cimcoz]

Sayın Ömer,
Bu sefer de sayfa geçişi yapınca bu hata çıkıyor. macOS MS Office bu vb konusunda bayağı sıkıntılı anladığım kadarıyla..

 

[cimcoz]

Nette de araştırma yaptım ama pek çözüm yok gibi.

 

[Ömer]

Konuyu daha müsait zamanda araştırırım.
Şimdi sizi de bekletmemek için yapıyı değiştirdim. Eki inceleyiniz.

 

[cimcoz]

Konuyu daha müsait zamanda araştırırım.
Şimdi sizi de bekletmemek için yapıyı değiştirdim. Eki inceleyiniz.

Sayın Ömer,

Pazar günü değerli vaktinizi ayırdığınız için öncelikle çok teşekkür ederim.

Dosya süper oldu ve sorunsuz çalışıyor.

Aşağıda mevcut kod ile ilgili eğer zaman ayırabilirseniz ufak bir değişiklik isteğim olacak.

Karne sayfasına AH sütunundan itibaren bazı hesaplama veren formülleri eklemem gerekiyor. (Bunlar gelen veriye göre hesaplama yapacak)
Sınıflar sayfasından Karne sayfasının sadece AG sütununa kadar alana veri gelmesi için ne yapabilirim?
Zira Siniflar sayfasında AG'den sonra yazdıklarımı da getirmekte ve herhangi bir sınıf seçince Karne sayfasındaki tüm alanlar silinip yeni veri gelmektedir. Sadece Karne sayfasındaki A-AG aralığını sildirip, sonraki sütunlarda (Karne sayfası için) olan/olacak hücre içeriklerini değiştirmesek. Böyle birşey için mevcut kodda nereye müdahale etmem gerekir?

Tekrar teşekkür ederim.

Saygılarımla,

 

[Ömer]

Kodlardaki,

Ss.Rows(c.Row).Copy Cells(sat, "A") yerine aşağıdaki bloğu yazın.

Ss.Cells(c.Row, "A").Resize(1, 33).Copy Cells(sat, "A")

 

[cimcoz]

Kodlardaki,

Ss.Rows(c.Row).Copy Cells(sat, "A") yerine aşağıdaki bloğu yazın.

Ss.Cells(c.Row, "A").Resize(1, 33).Copy Cells(sat, "A")

Sayın Ömer,

Çok teşekkür ederim.