Sütün ve Satırdaki Verile Göre Süzgeç Oluşturma Yardım Lütfen

[lazkes01]

Arkadaşlar Ekteki dosyadaki Tarihe göre kullanıcıların kaç adet görev araması aktif müşteri vs. bunların sayılarını çıkarmak istiyorum. Bu liste kısaltılmış olarak normal liste daha uzun olduğu için bunu kısa yolla halledebilirmiyim yardımcı olabilirmisiniz.

 

[Muhammet Okumuş]

Merhaba, eğer tablonuz bu şekilde düzenli ise aşağıdaki kodu uygulayınız. Döngüdeki 3ü veriniz kadar ayarlayınız.

Sub Süz()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("G3:L14") = "=SUMPRODUCT(--($C$1:$C$10000=G$2)*($A$1:$A$10000=$F3)*($D$1:$D$10000=$F$1))"
Range("G3:L14").Replace "$F$1", "F1"
For i = 2 To 3
x = i * 14 - 11
Range("G3:L14").Copy Range("G" & x)
Next i
Application.Calculation = xlCalculationAutomatic
Range("F1:L10000") = Range("F1:L10000").Value
End Sub

 

[lazkes01]

bunu formül olarak uygulayabilirmiyiz kod olayını hiç bilmiyorum nasıl yapacağımı filan

 

[Muhammet Okumuş]

Örnek dosyayı inceleyiniz.

 

[lazkes01]

Çok çok sağol ellerin dert görmesin çok işime yarayacak sayende

 

[Muhammet Okumuş]

Kodaların bu şekil doğru çalışabilmesi için tablonuz bu şekil olmalıdır. 1 satır eksik yada fazla olması hataya neden olur.

For i = 2 To 3 burdaki 3 sayısını tablo sayısı kadar değiştiriniz. Eğer veriler 10000 satırdan az ise 10000 değerini düşürünüz. Daha hızlı işlem yaparsınız.

 

[lazkes01]

satır ve sütun sayısı değişikliğinde nerede değişiklik yapmamız gerekiyor acaba

 

[Muhammet Okumuş]

Datada mı değişiklik yapacaksınız? Yoksa formüllerin olduğu yerde mi?

 

[lazkes01]

Tabloda yani F sutunu ile L sutunu arasındaki yerde satır ve sutun değişikliğinde bunlarda artma veya azaltma durumunda ne gibi değişiklik yapmam gerekiyor

 

[Muhammet Okumuş]

Kodları değiştirmek gerekiyor. Seçeceğiniz alana göre.

 

[lazkes01]

İlk tabloda F14 e kadar olna satır sayısını F18 e çıkarmak istiyorum. L sütunuda O sütununa kadar artırmak istiyorum. Yardımcı olabilirmisin bununla ilgili olarak

 

[Muhammet Okumuş]

Şablon sayfası üzerinde ekleme yapabilirsiniz. Başlangıç tarihi bitiş tarihin küçük olmalı.

Sub Aktar()
Application.ScreenUpdating = False
Set s = Sheets("Şablon")
Set d = Sheets("Data")
d.Range("F:FF").Delete
s.Range("E2:EE2").UnMerge
s.Range("E2:EE3").Interior.ColorIndex = 2
s.Range("E2:EE1000").Borders.LineStyle = 0
x = s.Cells(4, 3) - s.Cells(3, 3) + 1
sat = s.Cells(Rows.Count, "E").End(3).Row
sut = WorksheetFunction.CountA(s.Range("F3:FF3")) + 5
s.Range(s.Cells(2, 5), s.Cells(2, sut)).Merge
s.Range(s.Cells(2, 5), s.Cells(2, sut)).Interior.ColorIndex = 4
s.Range(s.Cells(3, 5), s.Cells(3, sut)).Interior.ColorIndex = 6
s.Range(s.Cells(2, 5), s.Cells(sat, sut)).Borders.LineStyle = 1
s.Range(s.Cells(4, 6), s.Cells(sat, sut)) = "=SUMPRODUCT(--(Data!$C$1:$C$10000=F$3)*(Data!$A$1:$A$10000=$E4)*(Data!$D$1:$D$10000=$E$2))"
For i = 1 To x
y = DateAdd("d", i - 1, s.Cells(3, 3))
s.Cells(2, 5) = y
say = WorksheetFunction.CountIf(d.Range("D11000"), y)
If say = 0 Then GoTo 10
son = d.Cells(Rows.Count, "F").End(3).Row + 1
s.Range(Cells(2, 5), Cells(sat, sut)).Copy
d.Cells(son, "F").PasteSpecial (xlPasteValues)
d.Cells(son, "F").PasteSpecial (xlPasteFormats)

10

Next

d.Columns(6).ColumnWidth = 30
d.Range("G:FF").ColumnWidth = 8
s.Range("E2") = ""
s.Range("F4:FF100") = ""
Application.CutCopyMode = False
d.Select
Range("F1").Select

Set s = Nothing
Set d = Nothing

End Sub

 

[lazkes01]

valla hocam ne diyeyim bilemiyorum harikasın ellerine sağlık çok uğraştırdım seni hakkını helal et. Şu işi öğrenmek lazım

 

[Muhammet Okumuş]

Rica ederim. İyi çalışmalar.

 

[lazkes01]

datada tarih olarak 01/03/2013 ile 31/03/2013 arasını yaptığım zaman 16 dan fazla tablo oluşturmuyor neden olabilir acaba

 

[Muhammet Okumuş]

Eğer o tarihler arasında Datada veri yoksa oluşturmaz. Demek ki datanızda 01/03/2013 ile 31/03/2013 tarihleri arasında 16 farklı tarih var.

 

[lazkes01]

hallettim hocam say = WorksheetFunction.CountIf(d.Range("D11000"), y) bu kodu D10000 olarak değiştirdim oldu Çok teşekkürler

 

[Muhammet Okumuş]

Veri aralığını kendinize göre düzenleyin. Ben ne kadar veriniz olduğunu bilmediğim için 1000 almışım.