Özet Veri

[serif_007]

Merhabalar;

Ekte örnek bir tablom var. veri sayfasındaki verilerden yola çıkarak özet sayfasına örnek veriyorum 01.01.2020 ile 31.01.2020 arasında içerisinde Aydına bağlı Bozdoğan'ın kaç sefer yazıldığını ocak sütununa sayısını yazmasını ve aynı zamanda veri tablosunda diyelim ki çine ilçesi yok çine yok ise hangi ayda yok ise karşılığına 0 yazmasını istiyorum. elimdeki veriler 10000 civarı olduğu için formül ile yaptığım zaman bilgisayarda tabloyu açmakta çok zorlanıyorum. 10000 veri her ay saydırılacağı için de 120000 veriyi formül ile saydırmak gerçekten çok zor oluyor. Bunu makro ile yapmak daha kolay olacak ama makro bilgim olmadığından birşey yapamadım. Biraz araştırdım ama bir çözüm bulamadım. Yardımlarınızı rica ediyorum.

 

[Necdet]

Merhaba,

Pivot Table işinizi görür mü?

 

[serif_007]

Necdet hocam pivotda denedim ama istediğim sonuca bir türlü ulaşamadım. Çünkü dediğim gibi olanları saydırmak kolay pivotta ama mesela dedim ya Çine ilçesi yoksa 0 olacak sütun karşılığında. Pivot Çine ilçesini hiç almayacak olmadığı için.

 

[serif_007]

Aslında yapmak istediğim çok basit birşey . Ama dosyanın orjinalini paylaşamıyorum şirket verisi içerdiği için bu nedenle biraz karmaşık oldu anlatmam

 

[çıtır]

Deneyiniz.

Sub saybk()
Dim s1 As Worksheet: Dim s2 As Worksheet
Dim i As Long: Dim j As Long:: Dim son1 As Long
Dim son2 As Long: Dim sons As Integer
Set wf = WorksheetFunction
Set s1 = Sheets("veri")
Set s2 = Sheets("özet")
Application.ScreenUpdating = False
son1 = s1.Cells(Rows.Count, "A").End(3).Row
son2 = s2.Cells(Rows.Count, "A").End(3).Row
sons = s2.Cells(1, 255).End(1).Column
s2.Select
s2.Range(Cells(2, 3), Cells(son2, sons)).ClearContents
For j = 3 To sons
Bast = CDbl(CDate(DateValue(1 & " /" & s2.Cells(1, j) & "/" & 2020)))
sont = CDbl(CDate(wf.EoMonth(Bast, 0)))
For i = 2 To son2
say = wf.CountIfs(s1.Range("A2:A" & son1), ">=" & Bast, s1.Range("A2:A" & son1), _
"<=" & sont, s1.Range("C2:C" & son1), s2.Range("B" & i))
s2.Cells(i, j) = say
Next i
Next j
Application.ScreenUpdating = True
MsgBox "İşlem tamam."
i = Empty: j = Empty: son1 = Empty: son2 = Empty: sons = Empty
  Set s1 = Nothing: Set s2 = Nothing: Set wf = Nothing
    End Sub

 

[serif_007]

Deneyiniz.

Sub saybk()
Dim s1 As Worksheet: Dim s2 As Worksheet
Dim i As Long: Dim j As Long:: Dim son1 As Long
Dim son2 As Long: Dim sons As Integer
Set wf = WorksheetFunction
Set s1 = Sheets("veri")
Set s2 = Sheets("özet")
Application.ScreenUpdating = False
son1 = s1.Cells(Rows.Count, "A").End(3).Row
son2 = s2.Cells(Rows.Count, "A").End(3).Row
sons = s2.Cells(1, 255).End(1).Column
s2.Select
s2.Range(Cells(2, 3), Cells(son2, sons)).ClearContents
For j = 3 To sons
Bast = CDbl(CDate(DateValue(1 & " /" & s2.Cells(1, j) & "/" & 2020)))
sont = CDbl(CDate(wf.EoMonth(Bast, 0)))
For i = 2 To son2
say = wf.CountIfs(s1.Range("A2:A" & son1), ">=" & Bast, s1.Range("A2:A" & son1), _
"<=" & sont, s1.Range("C2:C" & son1), s2.Range("B" & i))
s2.Cells(i, j) = say
Next i
Next j
Application.ScreenUpdating = True
MsgBox "İşlem tamam."
i = Empty: j = Empty: son1 = Empty: son2 = Empty: sons = Empty
  Set s1 = Nothing: Set s2 = Nothing: Set wf = Nothing
    End Sub

çok teşekkür ederim tam istediğim gibi Allah razı olsun

 

[çıtır]

çok teşekkür ederim tam istediğim gibi Allah razı olsun

Allah(C.C.) Cümlemizden razı olsun.Dönüş yaptığınız için teşekkür ederim.

 

[serif_007]

Allah(C.C.) Cümlemizden razı olsun.Dönüş yaptığınız için teşekkür ederim.

Çıtır hocam bir şeyi göz ardı ettiğim için bir sorunum var. Tabloyu kullanacağım şekilde biraz daha modifiye ettim Fakat sorun şu ki ;

Fider ismi yazan kısımda aynı istasyonda bulunan fiderlerin isimleri aynı olduğunda örnek veriyorum
İstasyon ismi Fider ismi Ocak
Bayrak DM Kapasitör 8
Efe DM Kapasitör 8
Akçaova DM Kapasitör 8


olarak görünüyor benim istediğim olay şu Bayrak DM - Kapasitör 1 sefer yazıyorsa özet tabloya
Bayrak DM Kapasitör 1
Efe DM - Kapasitör 2 sefer yazıyorsa özet tabloya
Efe DM - Kapasitör 2
Efe DM - Kapasitör 5 sefer yazıyorsa özet tabloya
Efe DM - Kapasitör 5 yazacak şekilde olacak. Makroyu bu şekilde nasıl çalıştırabilirim.

Şu an ki durumda veri sayfasının c sütunun da kapasitör metnini gördüğünde özet tablodaki bütün kapasitör karşılıklarına toplamlarını yazıyor