İki tarih arasını süz ve topla

[Karaibo15]

Ýki tarih arasını süz ve topla

:hey: Hayırlı Çalışmalar dileğiyle
Excel Çalışma Kitabımın 1 Sayfasının A10 hücresinden başlayan aşağı doğru 1000 adet isim listem var. B10 hücresinden başlayan yine bunların karşılığı SATIÞ TARİHLERİ ve C10'dan başlayan SATIÞ TUTARI mevcuttur.
TEXTBOX1'de İlktarih
TEXTBOX2'de son tarih
TEXTBOX3'de de Satışı yapan personel'in ismi mevcuttur.
Bu üç bilgiyi dikkate alarak süzen ve alt toplamı ayrı bir TEXTBOX'ta gösteren ayrıcada bir LİSTBOX'ta bütün bilgileri göstermek mümkünmü? :?

 

[Levent Menteşoğlu]

Ekteki örneği inceleyin.

 

[selections]

Private Sub CommandButton1_Click()
tarih1 = Format(ComboBox2, "0")
tarih2 = Format(ComboBox3, "0")
Range("b10:b2000").NumberFormat = "General"
Range("a9").Select
Selection.AutoFilter
Range("a9").AutoFilter Field:=1, Criteria1:=ComboBox1.Value
Range&#40;"a9"&#41;.AutoFilter Field&#58;=2, Criteria1&#58;=">=" & tarih1, Operator&#58;=xlAnd, Criteria2&#58;="<=" & tarih2
Range&#40;"b10&#58;b2000"&#41;.NumberFormat = "dd/mm/yyy"
ComboBox2 = ""
ComboBox3 = ""
Range&#40;"d9"&#41; = "=SUBTOTAL&#40;9,R&#91;1&#93;C&#91;-1&#93;&#58;R&#91;64991&#93;C&#91;-1&#93;&#41;"
TextBox1 = Range&#40;"d9"&#41;
End Sub

 

[mraltin]

Sn.Leventm buna benzer bir calismada benim var fakat benim calismamdaki veriler baska sayfaya kayitli siz userFormu ac butonu koydugunuz sayfa ile verilerin kayitli oldugu sayfa ayni yerde.benim form ac butonum ile veriler ayrı sayfalarda nasil yapabilirim.Ayrica Hazirladiginiz form cok guzel.tesekkurler

 

[Levent Menteşoğlu]

Rica ederim. Söylediğinizle ilgili bir çalışma yapıp yayınlarım.

 

[Levent Menteşoğlu]

Ekte verilerin farklı bir sayfadan alındığı örneği sunuyorum.

 

[mraltin]

Sn.leventm calismanizi formuma uygulayamadim.sanirim ben bunu yapamiycam.,
ListBox1.RowSource = adres da hata verdi.
sayfa adlarini degistirdim forma uyguladim yanliz benim Q ve S sutunlari dolu oldugu icin bunlari AZ ve BB diye degistirdim.

 

[mraltin]

arkadaslar biliyorum ayni sorulari tekrar tekrar soruyorum ama sorunu cozemedim yardimci oldugunuz icin tesekkur ederim.
Sn.Leventm yapmis oldugu calismadaki kodlari
Private Sub CommandButton1_Click()
Range("AZ2:BB65536").ClearContents
Set ad = Sheets("DATA")
sat = WorksheetFunction.CountA(ad.Range("A10:A65536"))
c = 0
d = 0
For satr = 10 To sat + 10
If ad.Cells(satr, 1).Value = TextBox3.Value And ad.Cells(satr, 2).Value >= CDate(TextBox1.Value) And ad.Cells(satr, 2).Value <= CDate(TextBox2.Value) Then
c = c + 1
d = d + ad.Cells(satr, 3).Value
Cells(c + 1, 17) = ad.Cells(satr, 1).Value
Cells(c + 1, 18) = ad.Cells(satr, 2).Value
Cells(c + 1, 19) = ad.Cells(satr, 3).Value
End If
Next satr
TextBox4 = d
adres = "ANA MENÜ!AZ2:BB" & c + 1
ListBox1.RowSource = adres
End Sub
gibi degistirdim fakat hala sorgulamayi Q-S olarak yapiyor bu degerleri ne yaparsam yapayim surekli Q-S olarak calisiyor bunu degistirmenin bir yolu varmi

 

[Levent Menteşoğlu]

Cells(c + 1, 17) = ad.Cells(satr, 1).Value
Cells(c + 1, 18) = ad.Cells(satr, 2).Value
Cells(c + 1, 19) = ad.Cells(satr, 3).Value

Satırlarını aşağıdaki gibi değiştirin.

[vb:1:9c907c47a3]Cells(c + 1, 52) = ad.Cells(satr, 1).Value
Cells(c + 1, 53) = ad.Cells(satr, 2).Value
Cells(c + 1, 54) = ad.Cells(satr, 3).Value[/vb:1:9c907c47a3]

 

[mraltin]

sn.leventm soylediginiz satırları degistirdim fakat
If ad.Cells(satr, 1).Value = TextBox3.Value And ad.Cells(satr, 2).Value >= CDate(TextBox1.Value) And ad.Cells(satr, 2).Value <= CDate(TextBox2.Value) Then
satırda hata aldim.

 

[Levent Menteşoğlu]

Hata veren satırın yukarıdaki düzeltmelerle bir ilgisi yok,dosyanızı gönderirseniz, onun üzerinden gidelim.

 

[mraltin]

iki tarih arasi suz

sn.leventm dosyayi ekte gonderiyorum.

 

[Levent Menteşoğlu]

Dosyanıza gerekli ilaveleri yaptım inceleyiniz. Bir yanlışlık varsa tekrar bildirirsiniz.

Not:Makroların daha sağlıklı çalışması açısında sayfa isimlerinde kelimeleri birleşik kullanın.

 

[mraltin]

TESEKKUR EDERİM SN.LEVENTM
istedigim oldu belki fazla sey istiyorum ama simdi sorgula butonuna basınca tarih aralığındaki veriler geliyor.veri bulunamadığında Mesaj verebilirmi(MsgBox)istediğiniz Kriterlere uyan kayıt bulunamadı gibi.
ilgilenen herkese tesekkur ederim

 

[Levent Menteşoğlu]

Sorgula butonundaki kodu aşağıdaki ile değiştirin.
[vb:1:4f1ef0c958]Range("AZ2:BC65536").ClearContents
Set ad = Sheets("DATA")
sat = WorksheetFunction.CountA(ad.Range("A2:A65536"))
c = 0
d = 0
For satr = 2 To sat + 2
If ad.Cells(satr, 2).Value >= CDate(TextBox1.Value) And ad.Cells(satr, 2).Value <= CDate(TextBox2.Value) Then
c = c + 1
d = d + ad.Cells(satr, 4).Value
Cells(c + 1, 52) = ad.Cells(satr, 1).Value
Cells(c + 1, 53) = ad.Cells(satr, 2).Value
Cells(c + 1, 54) = ad.Cells(satr, 3).Value
Cells(c + 1, 55) = ad.Cells(satr, 4).Value
End If
Next satr
If c = 0 Then
MsgBox ("Bu tarihler arası veri bulunamadı")
Exit Sub
End If
TextBox4 = d
adres = "ANAMENÜ!AZ2:BC" & c + 1
ListBox1.RowSource = adres
End Sub[/vb:1:4f1ef0c958]