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

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
3,049
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

Üst