Sayfalardan istenen düzende makro ile veri çekme

[farisakboga]

Aşağıda ekli excel dosyasında öğrencilerimin okuduğu ve sınavını oldukları hikaye kitapları var.

Amacım süreç boyunca okudukları kitapları (ilk üç sayfada yer alan hikaye setleri) "TOPLU" sayfasında birleştirerek toplamda kaç kitap okuduklarını ve aldıkları notları bir arada görebilmek.

Her hafta listelere ekleme olduğu için istediğim vakit bir makro düğmesine basarak hepsini "TOPLU" sayfasında oluşturduğum örnek düzene uygun listelemek.

Kısaca öğrenciyi, numarasını, okuduğu kitabı, puanını ve kaçıncı kitapta olduğunu üç sayfadan veri çekerek "TOPLU" sayfasına makro ile yazdırmak.

Bunu makro koduyla yapmamız mümkün mü?

Yardım edebililir misiniz?

 

[Necdet]

Merhaba,
Aklıma gelen ilk çözümü uyguladım. Tam olarak içime sinmedi ama şimdilik idare ediniz.

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

Sub Liste()

Dim arr As Variant, _
    diz As Variant, _
    i   As Long, _
    j   As Long, _
    s   As Integer

Application.ScreenUpdating = False

For s = 1 To Sheets.Count
    If Not Sheets(s).Name = "TOPLU" Then
        i = Sheets(s).Cells(Rows.Count, "E").End(3).Row
        j = j + (i - 3)
    End If
Next s

j = j + 1

Sheets("TOPLU").Range("A2:E" & Rows.Count).ClearContents
diz = Sheets("TOPLU").Range("A1:E" & j).Value

j = 1
For s = 1 To Sheets.Count
    If Not Sheets(s).Name = "TOPLU" Then
        i = Sheets(s).Cells(Rows.Count, "E").End(3).Row
        arr = Sheets(s).Range("C4:G" & i).Value
        For i = 1 To UBound(arr, 1)
            j = j + 1
            diz(j, 1) = arr(i, 3) 'Adı Soyadı
            diz(j, 2) = arr(i, 4) 'Okul No
            diz(j, 3) = arr(i, 5) 'Hikaye Adı
            diz(j, 4) = arr(i, 1) 'Puan
        Next i
    End If
Next s
    
Sheets("TOPLU").Select

Range("A1").Resize(UBound(diz, 1), UBound(diz, 2)) = diz
Range("A2:E" & UBound(diz, 1)).Sort Key1:=Range("B1"), Key2:=Range("C1")
diz = Range("A1").CurrentRegion.Value
    
For i = 2 To UBound(diz, 1)
    If Not diz(i, 2) = diz(i - 1, 2) Then j = 0
    j = j + 1
    diz(i, 5) = j
Next i

Range("A1").Resize(UBound(diz, 1), UBound(diz, 2)) = diz
Application.ScreenUpdating = True

End Sub

 

[farisakboga]

Merhaba,
Aklıma gelen ilk çözümü uyguladım. Tam olarak içime sinmedi ama şimdilik idare ediniz.

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

Public Sub Liste()

Dim arr As Variant, _
    diz As Variant, _
    i   As Long, _
    j   As Long, _
    s   As Integer

Application.ScreenUpdating = False

For s = 1 To Sheets.Count
    If Not Sheets(s).Name = "TOPLU" Then
        i = Sheets(s).Cells(Rows.Count, "E").End(3).Row
        j = j + (i - 3)
    End If
Next s

j = j + 1

Sheets("TOPLU").Range("A2:E" & Rows.Count).ClearContents
diz = Sheets("TOPLU").Range("A1:E" & j).Value

j = 1
For s = 1 To Sheets.Count
    If Not Sheets(s).Name = "TOPLU" Then
        i = Sheets(s).Cells(Rows.Count, "E").End(3).Row
        arr = Sheets(s).Range("C4:G" & i).Value
        For i = 1 To UBound(arr, 1)
            j = j + 1
            diz(j, 1) = arr(i, 3) 'Adı Soyadı
            diz(j, 2) = arr(i, 4) 'Okul No
            diz(j, 3) = arr(i, 5) 'Hikaye Adı
            diz(j, 4) = arr(i, 1) 'Puan
        Next i
    End If
Next s
   
Sheets("TOPLU").Select

Range("A1").Resize(UBound(diz, 1), UBound(diz, 2)) = diz
Range("A2:E" & UBound(diz, 1)).Sort Key1:=Range("B1")
diz = Range("A1").CurrentRegion.Value
   
For i = 2 To UBound(diz, 1)
    If Not diz(i, 2) = diz(i - 1, 2) Then j = 0
    j = j + 1
    diz(i, 5) = j
Next i

Range("A1").Resize(UBound(diz, 1), UBound(diz, 2)) = diz
Application.ScreenUpdating = True

End Sub

Çok teşekkür ederim. Kod gayet güzel çalışıyor. Kitap adı kısmını öğrenci özelinde alfabetik sırada dizmek mümkün mü?

 

[Necdet]

Merhaba.

Kodu yeniledim ama Kitap adlarını düzgün sıralayacağını sanmıyorum. Çünkü bazılarında önce numara var bazılarında ise yok.
Eğer düzenlerseniz kitap adlarını sıralama düzgün olacaktır.

 

[farisakboga]

Merhaba.

Kodu yeniledim ama Kitap adlarını düzgün sıralayacağını sanmıyorum. Çünkü bazılarında önce numara var bazılarında ise yok.
Eğer düzenlerseniz kitap adlarını sıralama düzgün olacaktır.

Tam istediğim gibi oldu. Çok teşekkür ederim.