• DİKKAT

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

Hiyerarşik yapıda class nesnesi oluşturma hk.

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
3,201
Excel Vers. ve Dili
Office 2013 İngilizce
Merhabalar,
Class module' i öğrenmek adına ekli dosyada olduğu gibi bir çalışma yapmaya çalışmıyorum.

Ekli görselde görüleceği üzere Hiyerarşik Yapıda;

en üstte Ders var, her bir Dersin altında Kitaplar, Kitapların altında Üniteler bulunuyor.

Ekli dosyada Ders adında nesneyi oluşturdum. yalnız her bir dersin altında kitap nesnelerini (kitap-1, kitap-2, kitap-3 , ...... ) oluşturmakta takıldım,
kitap nesnesini oluşturduktan sonra; her kitap nesnesinin altına ünite nesnelerini (ünite-1, ünite-2, ünite-3 , ...... )
ünite nesnesini oluşturduktan sonra; her ünite nesnesinin altına test nesnelerini (test-1, test-2, test-3 , ...... ) oluşturacağım.

ders.kitap.unite.test

günün sonunda hedefim ctestlerin soru sayılarına ulaşmak ve cass module işlevini öğrenmek...

teşekkürler, iyi Akşamlar.

class:
Kod:
Public name As String
Private m_Book As clsBook
Private Sub Class_Initialize()
    Set m_Book = New clsBook
End Sub
Public Property Get cBook() As clsBook
    Set cBook = m_Book
End Property

module:
Kod:
Sub useCollection()
Dim Rng As Range
Dim arr() As Variant
Dim name As String, Name2 As String
Dim i As Integer, j As Integer, x As Integer

Dim book As clsBook
Dim ders As clsLesson


Dim coll As New Collection
Dim coll2 As New Collection

Set Rng = Sayfa2.Range("B2:B5")

For i = 1 To Rng.Rows.Count

    name = Rng.Cells(i, 1).Value

        If Exists(coll, name) = False Then
            Set ders = New clsLesson
            ders.name = name
            coll.Add key:=name, Item:=ders
        Else
            Set ders = coll(name)
        
        End If
        
        x = 0
         For j = 2 To 20
            ReDim Preserve arr(x)
            arr(x) = Sayfa2.Cells(j, i + 4)
            x = x + 1

        Next j
        

            For x = LBound(arr) To UBound(arr)
            Name2 = ""
            
                Name2 = arr(x)
                
                If Name2 <> "" Then
                
                    With ders
'''                        Set book = .cBook
'''                        ders.cBook.Name2 = name2
'''                        coll2.Add key:=name2, Item:=book
                    End With
               End If
                    
            Next x

Next i


End Sub
 

Ekli dosyalar

  • 123.jpg
    123.jpg
    41.2 KB · Görüntüleme: 6
  • Ders.xlsb
    Ders.xlsb
    74.9 KB · Görüntüleme: 4
Geri
Üst