• DİKKAT

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

Liste Alma

Katılım
29 Mart 2005
Mesajlar
84
Excel Vers. ve Dili
excel 2003
Merhaba!
Herkese kolay gelsin.

Benim sayfa1 'de listem var. Liste şu şekilde;

A sütunu B sütunu C Sütunu

Grup No Yılı Miktar
12345 2017 8
14368 2015 12
12345 2016 9
14368 2018 22

gibi..


Ben başka bir sayfaya;

Grup No 2015 Yılı 2016 yılı 2017 yılı 2018 yılı
12345 9 8
14368 12 22


bu şekilde yapmak istiyorum.
Teşekkür ederim

Selam ve saygılarımla
 
Merhaba,

Sayfa1 verilerin olduğu sayfa,
Sayfa2 istenilen sonuç sayfanız.

Kod:
Sub tablo()
  Set s1 = Sheets("Sayfa1")
  Set s2 = Sheets("Sayfa2")
  a = s1.Range("A2:C" & s1.Cells(Rows.Count, 1).End(xlUp).Row).Value
  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  ReDim b(1 To UBound(a), 1 To UBound(a))
    For i = 1 To UBound(a)
        krt1 = CStr(a(i, 1))
        If Not d1.exists(krt1) Then
            d1(krt1) = d1.Count + 1
            sat = d1.Count
        End If
        sat = d1(krt1)
        krt2 = CStr(a(i, 2))
        If Not d2.exists(krt2) Then
            d2(krt2) = d2.Count + 1
            sut = d2.Count
        End If
        sut = d2(krt2)
        b(sat, sut) = b(sat, sut) + CDbl(a(i, 3))
    Next i
    Application.ScreenUpdating = False
    s2.Cells.Clear
    s2.[A2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
    s2.[B1].Resize(1, d2.Count) = d2.keys
    s2.[B2].Resize(d1.Count, d2.Count) = b
    s2.[A1].Resize(d1.Count + 1, d2.Count + 1).Borders.Color = 1
   
    s2.[A2].Resize(d1.Count, d2.Count + 1).Sort key1:=s2.[A2], _
        Order1:=xlAscending, Header:=xlNo, MatchCase:=False, Orientation:=xlSortColumns

    s2.[B1].Resize(d1.Count + 1, d2.Count).Sort key1:=s2.[B1], _
        Order1:=xlAscending, Header:=xlNo, MatchCase:=False, Orientation:=xlSortRows
    Application.ScreenUpdating = t
    s2.Select
End Sub
 
Merhaba!
Sayın Ziynettin;
İlginize teşekkür ederim.

ReDim b(1 To UBound(a), 1 To UBound(a))

satırında "out of memory" hatası veriyor. Bendeki dosyada çok sayıda ( 9000 civarı kayıt var )

ondan mıdır acaba?

100 , 200 kayıtta sorunsuz çalışıyor.
saygılar
 
Geri
Üst