• DİKKAT

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

VBA içinde özet tablo benzeri işlemler

Katılım
1 Mart 2012
Mesajlar
27
Excel Vers. ve Dili
2010 - EN
Merhaba,

Excel sayfası içinde özet tablo yaratmadan, doğrudan VBA içinde dizilerle özet tablo benzeri bir yapı nasıl kurulabilir?

Örneğin satır bazında öğrenci numaraları ve karşılarında aldıkları dersler listelenmiş olsun:

Öğrenci1 - Ders1
Öğrenci1 - Ders2
Öğrenci2 - Ders1
Öğrenci2 - Ders3
Öğrenci3 - Ders2
Öğrenci3 - Ders4

gibi. Benim yapmak istediğim 2 boyutlu bir dizi yaratıp (ilk indeks öğrenci numarası, ikinci indeks dersler için olmak üzere) eğer öğrenci o dersi alıyorsa 1, değilse 0 değerini tutmak. Kabaca ekteki dosyadaki özet tabloyu iki boyutlu bir diziye çekmek istiyorum sayfa içinde özet tablo yaratmadan.

Bir de öğrenci numaraları sayı olabilir ama ders kodları string şeklinde, bunu dizi indeksi olarak verme şansım yok değil mi, sayı olarak kodlamalıyım bir şekilde?

Kafa yoran herkese şimdiden teşekkürler.
 

Ekli dosyalar

Ekli dosyayı inceleyiniz.
Formüllerle oluşan tablo koşullu biçimlendirme ile renklendirilmiştir.
 

Ekli dosyalar

Teşekkürler dosya için.
Formüllerle yapabiliyorum ancak amacım VBA içinde yapmak.
 
Dictionary ile yapılabileceğini söyleyenler oldu, birkaç ayrı yerde de okudum ancak dictionary'de birden fazla indeks nasıl kullanılır çözemedim. Fikri olan var mı?
 
Aşağıdaki kodu dener misin? İşini görür umarım.
Kod:
Sub dersHesap()

    endRow = Range("A1:A" & Rows.Count).End(xlDown).Row
    endCol = Cells(2, Columns.Count).End(xlToLeft).Column - 1

    For x = 3 To endRow
        For y = 7 To endCol
            Cells(x, y) = WorksheetFunction.CountIfs(Range("A2:A" & endRow), Range("F" & x), Range("B2:B" & endRow), Cells(2, y))
            iRow = Range(Cells(x, 7), Cells(x, y))
            Cells(x, 16) = WorksheetFunction.Sum(iRow)
        Next
    Next

End Sub
 
Merhaba,

VBA' nın dizi (array) özelliği kullanılarak yapılabilir. Forumda "Redim" ifadesi ile arama yapın. Birçok örneğe ulaşabilirsiniz.
 
Selamlar tekrar,

SadiSerdari, kod için teşekkür ederim. Sanırım turist'in dosyasındaki tabloyu taslak alarak yaptınız, onun üzerinde çalışıyor. Bir iki modifikasyonla aşağıda bahsedeceğim işlemlere entegre edebilirim sanırım. Elinize sağlık.

Korhan Ayhan, aşağı yukarı çalıştığım öğrenci sayısı ve ders sayısı belli aslında. Maksimum 150 ders ve maksimum 1500 öğrenci ile diziyi baştan sınırlayabilirim. Benim collection ya da dictionary'lere yönelme sebebim biraz indeksi string olarak tutabilmelerinden kaynaklıydı.

Örneğin tek boyutlu düşünürsek dersi alan öğrenci sayısını tutan bir dizi olsun. Burada öncelikle dersler için ayrı bir dizi tutmam gerekecek sanırım, sayısal indeksi olacak ve değer karşılığı da ders kodu olacak. Daha sonra spesifik bir ders kodu için öğrenci sayısını çekmek istediğimde öncelikle o dersin indeksini bulmak için ilk dizide değeri bulana kadar karşılaştırma yapmam, sonra da o indeksi diğer diziye göndermem gerekecek.

Ben VBA'da epey yeniyim, buradaki kodları kurcaladıkça kendim makro kaydedip oradan düzeltme yoluyla yaptığım şeylere nazaran epey etkin şeylerle karşılaşıyorum (hiç gereği yokken hücre ya da sayfa seçme/etkinleştirme işlemleriyle 30 saniyelik makroları 10 dakikada falan çalıştırdığım oldu mesela).

Bu örnekte de Excel'in özet tablosunun epey hızlı çalıştığını gördüğümden, SQL'de vs. benzer fonksiyonlar olduğundan acaba kendi yazacağımdan daha etkin bir şey hazır fonksiyon olarak VBA'nın içinde var mıdır, yoksa da ben baştan daha etkin bir şekilde tasarlayabilir miyim diye merak ettiğimden tecrübelerinize dayanarak size danıştım. Yoksa dediğim gibi epey yeni olduğumdan ancak fikir yürütüyorum.

Tekrar teşekkürler.
 
Merhaba,

Sizin amacınız özet tablo ile oluşturduğunuz tabloyu makro ile oluşturmak mı?

Eğer öyle ise klasik döngülerle de karmaşık yapılara girmeden halledilebilir. Madem makro bilginiz az bu durumda temel kodlamalardan başlamanız daha uygun olacaktır.
 
Evet. Doğrudan sayfa üzerinde bir tablo oluşturmaktan ziyade dizi ya da dizi benzeri bir yapıda depolamak asıl amacım, sonraki birçok tabloyu etkileyen ara bir tablo çünkü bu.

Dediğiniz gibi dizilerle başlıyorum. Eğer çok şişmeye başlarsa ona göre alternatiflere tekrar bakarım.

Teşekkürler.
 
bence pivot tablo imkanı var iken o kullanılmalı.

ama pivot benzeri array isteniyorsa aşağıdaki iş görür. tabii bundan sonra ne yapılacağı kısmı önemli. ben S1 hücresinden başlayarak sayfaya yazdırdım.

Kod:
Sub PivotYerineArray()

    Dim strNo As String, strDers As String
    Dim arrNo, arrDers, arrPivot()
    Dim LR As Long, i1 As Long, i2 As Long
    Dim cl As Range, rngNo As Range, rngDers As Range
    
    On Error Resume Next
    ThisWorkbook.Names("No").Delete
    ThisWorkbook.Names("Ders").Delete
    On Error GoTo 0
    
    With Sheets("Sheet1")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        Set rngNo = .Range("A2:A" & LR)
        Set rngDers = .Range("B2:B" & LR)
        ThisWorkbook.Names.Add Name:="No", RefersTo:=rngNo
        ThisWorkbook.Names.Add Name:="Ders", RefersTo:=rngDers
        For Each cl In Range("No")
            If InStr(strNo, cl.Value) = 0 Then strNo = strNo & "|" & cl.Value
        Next
        For Each cl In Range("Ders")
            If InStr(strDers, cl.Value) = 0 Then strDers = strDers & "|" & cl.Value
        Next
    End With
    
    arrNo = Split(Mid(strNo, 2), "|")
    arrDers = Split(Mid(strDers, 2), "|")
    
    ReDim arrPivot(0 To UBound(arrNo), 0 To UBound(arrDers) + 1)
    
    For i1 = 0 To UBound(arrNo)
        arrPivot(i1, 0) = arrNo(i1)
        For i2 = LBound(arrDers) + 1 To UBound(arrDers) + 1
            If Evaluate("=SUMPRODUCT((No=""" & arrNo(i1) & """)*(Ders=""" & arrDers(i2 - 1) & """))") > 0 Then
                arrPivot(i1, i2) = 1
            Else
                arrPivot(i1, i2) = 0
            End If
        Next
    Next
    
    Sheets("Sheet1").Range("S1").Resize(UBound(arrPivot, 1) + 1, UBound(arrPivot, 2) + 1).Value = arrPivot

End Sub
 
Son düzenleme:
Geri
Üst