Benzersiz Verilerden Tablo Yapma

[Astalavista58]

Merhabalar, hayırlı akşamlarınız olsun. Ekteki örnek dosyada C ve D sütunundaki veriyi toplayıp E sütununa yazdırmak istiyorum. B sütununda yer alan şehir isimlerini (benzersiz şekilde) Sayfa2'de 1. satıra, E sütununda topladığım veriyi ise Sayfa2'de A sütununa (benzersiz şekilde) yazdırıp, hangi Şehir isminde, benzersiz olarak yapıştırdığım tarihlerde kaç tane olduğu bulmak istiyorum. Aslında formül ile yapıyorum ancak şehir ve tarihler değiştiğinden her seferinden biraz uğraştırıyor. Bu konuda yardımcı olabilir misiniz. Şimdiden çok teşekkür ederim.

https://s6.dosya.tc/server3/7ok2tv/Ornek.xltm.html

 

[Astalavista58]

Excel dosyasını yanlış uzantıda yüklemişim çok özür dilerim. Düzgün halini tekrardan yükledim.

https://s6.dosya.tc/server3/ffma6k/Ornek1.xlsm.html

 

[Korhan Ayhan]

Örnek dosyayı inceleyiniz.

Formülle hazırladım. Hazırladığım tablonun sınırlarını sarı renkle belirttim. O alanın hepsinde formüller var. Veri durumuna göre görünür olacaktır.

Tablo yetersiz gelirse formülleri alta ve sağa doğru çoğaltabilirsiniz.

 

[Astalavista58]

Korhan bey çok teşekkür ederim. Çok işime yaradı. Yazmış olduğunuz formül "Dizi Formül" müdür

 

[Korhan Ayhan]

Evet...

 

[Ziynettin]

Alternatif makro çalışması.

Sub kod()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set dc = CreateObject("scripting.dictionary")
Set dz = CreateObject("scripting.dictionary")
Set ds = CreateObject("scripting.dictionary")
son = s1.Cells(Rows.Count, 2).End(3).Row
a = s1.Range("A1:D" & son).Value

For i = 2 To UBound(a)
    a(i, 1) = a(i, 3) + a(i, 4)
    dc(a(i, 1)) = ""
    dz(a(i, 2)) = ""
    krt = a(i, 1) & "|" & a(i, 2)
    ds(krt) = ds(krt) + 1
Next i

v1 = dc.keys: v2 = dz.keys
sat = dc.Count: sut = dz.Count

ReDim b(1 To sat + 2, 1 To sut + 1)

say = 1
For i = 0 To sat - 1
    say = say + 1
    b(say, 1) = v1(i)
    For j = 0 To sut - 1
        b(1, j + 2) = v2(j)
        krt = v1(i) & "|" & v2(j)
        b(say, j + 2) = ds(krt)
        b(sat + 2, j + 2) = b(sat + 2, j + 2) + ds(krt)
    Next j
Next i
s2.Cells.ClearContents
s2.Cells.ClearFormats
b(1, 1) = "TARİH \ ŞEHİR"
b(sat + 2, 1) = "Toplam"
s2.[A1].Resize(sat + 2, sut + 1) = b
s2.[A1].Resize(sat + 2, sut + 1).Borders.Color = rgbSilver
s2.[A1].Resize(sat + 2, sut + 1).ColumnWidth = 15
s2.[A2].Resize(sat).NumberFormat = "dd.mm.yyyy"

MsgBox "İşlem tamam.", vbInformation
End Sub

 

[Astalavista58]

Ziynettin bey elinize sağlık çok teşekkür ederim makro çalışıyor.