Çözüldü Filtreleme Hakkında

yesimgurol · 6 Aralık 2023

Merhaba ,

F3 ve I3 hücrelerine yazmış olduğum tarihlere göre A2:C100 aralığına filtreleme yapmak istemekteyim. Şöyle ki,

A sütununa ; yazılan tarihler ( hangi tarihlerde veri varsa o tarih isimleri)

B sütununa ; " a " sayfasındaki "K" sütunundaki veriyi,

C sütununa : "b" sayfasındaki "C" sütunundaki veriyi aldırmaya çalışıyorum.:-((

Ziynettin · 7 Aralık 2023

Kod:

Sub test()
Dim a(), b(), c(), dc As Object
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Dim trh1 As Date, trh2 As Date
Dim i As Long, say As Long, son As Long

Set s1 = Sheets("a")
Set s2 = Sheets("b")
Set s3 = Sheets("rapor")
Set dc = CreateObject("scripting.dictionary")

trh1 = s3.[F3]
trh2 = s3.[I3]

If trh1 > trh2 Then MsgBox "Hatalı Tarih.", vbExclamation: Exit Sub

son = s1.Range("M" & Rows.Count).End(3).Row
If son > 1 Then
    a = s1.Range("A1:M" & son).Value
    ReDim c(1 To UBound(a), 1 To 3)
    For i = 2 To UBound(a)
        If a(i, 13) >= trh1 And a(i, 13) <= trh2 Then
            trh = a(i, 13)
            If Not dc.exists(trh) Then
                dc(trh) = dc.Count + 1
                say = dc.Count
            Else
                say = dc(trh)
            End If
            c(say, 1) = trh
            c(say, 2) = a(i, 11)
        End If
    Next i
End If

son = 0
son = s2.Range("D" & Rows.Count).End(3).Row
If son > 2 Then
    a = s2.Range("A2:D" & son).Value
    For i = 2 To UBound(a)
        If a(i, 4) >= trh1 And a(i, 4) <= trh2 Then
            trh = a(i, 4)
            If Not dc.exists(trh) Then
                dc(trh) = dc.Count + 1
                say = dc.Count
            Else
                say = dc(trh)
            End If
            c(say, 1) = trh
            c(say, 3) = a(i, 3)
        End If
    Next i
End If

Application.ScreenUpdating = False
s3.Range("A4:C" & Rows.Count).ClearContents
s3.Range("A4:C" & Rows.Count).ClearFormats
If dc.Count > 0 Then
    s3.[A4].Resize(dc.Count).NumberFormat = "dd.mm.yyyy"
    s3.[A4].Resize(dc.Count, 3) = c
End If
Application.ScreenUpdating = True
MsgBox "İşlem Tamam.", vbInformation
End Sub

yesimgurol · 7 Aralık 2023

Ziynettin bey çok teşekkür ederim ilginiz ve emeğiniz için. İstediğim şekilde olmuş.Saygılarımla.

yesimgurol · 9 Aralık 2023

Ziynettin' Alıntı:

Kod:

Sub test()
Dim a(), b(), c(), dc As Object
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Dim trh1 As Date, trh2 As Date
Dim i As Long, say As Long, son As Long

Set s1 = Sheets("a")
Set s2 = Sheets("b")
Set s3 = Sheets("rapor")
Set dc = CreateObject("scripting.dictionary")

trh1 = s3.[F3]
trh2 = s3.[I3]

If trh1 > trh2 Then MsgBox "Hatalı Tarih.", vbExclamation: Exit Sub

son = s1.Range("M" & Rows.Count).End(3).Row
If son > 1 Then
    a = s1.Range("A1:M" & son).Value
    ReDim c(1 To UBound(a), 1 To 3)
    For i = 2 To UBound(a)
        If a(i, 13) >= trh1 And a(i, 13) <= trh2 Then
            trh = a(i, 13)
            If Not dc.exists(trh) Then
                dc(trh) = dc.Count + 1
                say = dc.Count
            Else
                say = dc(trh)
            End If
            c(say, 1) = trh
            c(say, 2) = a(i, 11)
        End If
    Next i
End If

son = 0
son = s2.Range("D" & Rows.Count).End(3).Row
If son > 2 Then
    a = s2.Range("A2:D" & son).Value
    For i = 2 To UBound(a)
        If a(i, 4) >= trh1 And a(i, 4) <= trh2 Then
            trh = a(i, 4)
            If Not dc.exists(trh) Then
                dc(trh) = dc.Count + 1
                say = dc.Count
            Else
                say = dc(trh)
            End If
            c(say, 1) = trh
            c(say, 3) = a(i, 3)
        End If
    Next i
End If

Application.ScreenUpdating = False
s3.Range("A4:C" & Rows.Count).ClearContents
s3.Range("A4:C" & Rows.Count).ClearFormats
If dc.Count > 0 Then
    s3.[A4].Resize(dc.Count).NumberFormat = "dd.mm.yyyy"
    s3.[A4].Resize(dc.Count, 3) = c
End If
Application.ScreenUpdating = True
MsgBox "İşlem Tamam.", vbInformation
End Sub

Ziynettin bey tekrar merhaba,
Yapmış olduğunuz kodlarla çalışmaya başladığımda bir hususta sorun yaşadım. Şöyle ki , kodlarda ilgili tarih aralıklarını ilgili sayfalarda arayıp buluyor ve ilgili verileri ilgili hücrelere alıyor. Yalnız arama yapılan sayfalarda aranan tarih 1 adet olduğunda sorun yok, fakat birden fazla olduğunda toplamlarını almam gerekiyor. Örnek verecek olursam ,
Mesela,
- Yazdığım tarih 01.01.2023 olsun, (bu tarihte SATIS sayfasında toplam ne kadar satış yapılmış onu bulmak amacım)
Kusura bakmayın hata bende çünkü ilk mesajımda bu hususu atlamışım. Dosya ile orijinal verilerle çalışmaya başlayınca fark ettim durumu:-(

Son haliyle dosyamı da eklemiş oldum.

Ziynettin · 9 Aralık 2023

Düzenlenmiş dosyanız.

yesimgurol · 9 Aralık 2023

Ziynettin' Alıntı:
Düzenlenmiş dosyanız.

Ziynettin bey çok teşekkür ederim. Harika oldu. Emeğinize sağlık. Saygılarımla.

yesimgurol · 14 Aralık 2023

Merhaba,
Dosyamı ilk oluşturduğumdaki isteklerim doğrultusunda Sayın Ziynettin bey çözüm için kodları yazmıştı ve gayet güzelde çalışıyordu. Lakin rutin işlemlere geçtiğimde farklı işlemlere gereksinim duyma ihtiyacı oluştu maalesef. Konuyu özetlemem gerekir ise;

RAPOR sayfasında Hali hazırdaki kodlar (5 nolu mesajda yer alan dosya) ;

- B3 ve B4 hücrelerine yazılan tarih aralıklarını ( satıs ve gider) sayfalarında ilgili sütunlarda arıyor ve bulduğunda ;

1 ) B sütunu için ;

- SATIŞ sayfasındaki K sütunundaki tutarların toplamını alıyor.

2 ) C sütunu için ;

- GİDER sayfasındaki C sütunundaki tutarların toplamını alıyor.

3 ) D sütunu için;

- B sütunundaki tutardan C sütunundaki tutarı çıkarıyor.

Revize edilmesi gereken kısımlar ise ;

Tarih aralıklarını hücreye yazıyordum fakat şimdi form oluşturdum ve textboxlara yazmam gerekiyor:-(

1) nolu kısımda sorun yok,

2) nolu kısımda yine gider sayfasında C sütununda arama yapılacak fakat bir şarta bağlı olacak o da sadece B sütununda "DÜKKAN GİDERİ" yazan tutarların toplamını almasını gerekecek.

3) nolu kısımda sorun yok,

Tüm bunlara ek olarak bir de E sütunu için ;

- yine gider sayfasında C sütununda arama yapılacak buranın şartı da B sütununda "TOPLU HARCAMA" yazan tutarların toplamının alınması gerekiyor.

Erkan Akayay · 15 Aralık 2023

Dosyanız anlattıklarınzıdan biraz farklı gibi. D sütunu boş. E sütununda birleşmiş bir hücre var.

yesimgurol · 15 Aralık 2023

Erkan Akayay' Alıntı:
Dosyanız anlattıklarınzıdan biraz farklı gibi. D sütunu boş. E sütununda birleşmiş bir hücre var.

Erkan bey ilginiz ve dikkatiniz için teşekkür ederim. Kusura bakmayın evet yanlış dosyayı yüklemişim. Şİmdi güncelledim dosyayı.

Ziynettin · 15 Aralık 2023

Dosya ekte

form üzeride deneyin.

yesimgurol · 15 Aralık 2023

Ziynettin bey,
Valla nasıl teşekkür etsem az. Harikasınız süper olmuş. Emeğinize sağlık, çok teşekkür ederim. Son bir şey sorsam kodlar çok ama çok güzel çalışıyor bunda sorunum kalmadı şükür, verilerin geldiği hücreleri biçimlendiriyorum ( verilerin ortalanması, hücre kenarlıkları v.s. ) kodu çalıştırınca gelen veriler bu biçimlendirmeleri kaybediyor:-( Önerinizi merak ettim bu konuda.

Erkan Akayay · 15 Aralık 2023

Kodda şu satır dediğiniz işlemi yapıyor.
s3.Range("A10:E" & Rows.Count).ClearFormats
O satırı kaldırın.

yesimgurol · 15 Aralık 2023

Erkan Akayay' Alıntı:
Kodda şu satır dediğiniz işlemi yapıyor.
s3.Range("A10:E" & Rows.Count).ClearFormats
O satırı kaldırın.

Teşekkür ederim, Erkan bey ilginiz için.

yesimgurol · 17 Aralık 2023

Tekrar merhaba,
Sayın Ziynettin bey'in 10 nolu mesajındaki kodlar gayet güzel çalışmakta fakat iş yerinde rutin işleri yaparken şöyle bir sorunla karşılaştım.

Bu arada kodların içerisindeki tarih formatı şu şekilde ;

Kod:

 s3.[A10].Resize(dc.Count).NumberFormat = "dd.mm.yyyy"

Aynı zamanda verilerin alındığı sayfalardaki tarih sütunları aynı formatta (hücre biçimlendirme kısmından hepsini aynı ayarlıyorum.)

Karşılaşmış olduğum sorun ise ;
Tarih aralıklarını ;

- 01.01.2023 - 01.12.2023 olarak girdiğimde sorun olmuyor gayet güzel veriler listeleniyor.
- 01.01.2023 - 10.12.2023 olarak girdiğimde sorun olmuyor gayet güzel veriler listeleniyor.
- 01.01.2023 - 11.12.2023 olarak girdiğimde ise uyarı vermiyor lakin 11.12.2023 tarihindeki verileri iki kez listeliyor. Resimdeki gibi,

- 01.01.2023 - 12.12.2023
- 01.01.2023 - 30.12.2023 olarak girdiğimde ise hata mesajı alıyorum. :-(

Girilen tarih formatları aynı olmasına rağmen bu sorunun nedeni nedir acaba:-( Orjinal dosyam ektedir.

Ziynettin · 17 Aralık 2023

Bu şekilde deneyin.

Kod:

Private Sub CommandButton1_Click()
If TextBox1.Value = "" Or TextBox2.Value = "" Then
        MsgBox "Lütfen tüm zorunlu alanları doldurun!", vbExclamation, "Uyarı"
         Exit Sub
    End If


Dim a(), b(), c(), dc As Object
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Dim trh1 As Date, trh2 As Date, TRH As Date
Dim I As Long, Say As Long, son As Long

Set s1 = Sheets("satıs")
Set s2 = Sheets("Gider")
Set s3 = Sheets("rapor")
Set dc = CreateObject("scripting.dictionary")

trh1 = TextBox1
trh2 = TextBox2




If trh1 > trh2 Then MsgBox "Hatalı Tarih, Tarih kısımları boş veya ilk tarih son tarih aralığı uyumsuz.", vbExclamation: Exit Sub

son = s1.Range("L" & Rows.Count).End(3).Row
If son > 9 Then
    a = s1.Range("A9:L" & son).Value
    ReDim c(1 To Rows.Count, 1 To 5)
    For I = 2 To UBound(a)
        If CDate(a(I, 12)) >= trh1 And CDate(a(I, 12)) <= trh2 Then
            TRH = CDate(a(I, 12))
            If Not dc.exists(TRH) Then
                dc(TRH) = dc.Count + 1
                Say = dc.Count
            Else
                Say = dc(TRH)
            End If
            c(Say, 1) = TRH
            c(Say, 2) = c(Say, 2) + a(I, 11)
            c(Say, 4) = c(Say, 2)
        End If
    Next I
End If

son = 0
son = s2.Range("D" & Rows.Count).End(3).Row
If son > 9 Then
    a = s2.Range("A9:D" & son).Value
    
    For I = 2 To UBound(a)
        
        
    
        If a(I, 4) >= trh1 And a(I, 4) <= trh2 Then
            TRH = a(I, 4)
            If Not dc.exists(TRH) Then
                dc(TRH) = dc.Count + 1
                Say = dc.Count
            Else
                Say = dc(TRH)
            End If
            c(Say, 1) = TRH
            If a(I, 2) = "DÜKKAN GİDERİ" Then c(Say, 3) = c(Say, 3) + a(I, 3)
            c(Say, 4) = c(Say, 2) - c(Say, 3)
            If a(I, 2) = "TOPLU HARCAMA" Then c(Say, 5) = c(Say, 5) + a(I, 3)
        End If
    Next I
End If

Application.ScreenUpdating = False
s3.Range("A10:E" & Rows.Count).ClearContents

If dc.Count > 0 Then
    s3.[A10].Resize(dc.Count).NumberFormat = "dd.mm.yyyy"
    s3.[B10].Resize(dc.Count, 4).NumberFormat = "#,##0.00"
    s3.[A10].Resize(dc.Count, 5) = c
    Dim rg As Range
    Set rg = s3.[A10].Resize(dc.Count, 5)
    rg.Sort rg(1, 1), xlAscending
End If
s3.[A9:E9].AutoFilter
Application.ScreenUpdating = True
MsgBox "İşlem Tamam.", vbInformation
'RAPORFLTRETEMIZ
'RAPORTARIHSIRA
'
End Sub

yesimgurol · 17 Aralık 2023

Ziynettin bey, harikasınız çok ama çok teşekkür ederim. Emeğinize sağlık. Çok güzel oldu sayenizde. Saygılarımı sunuyorum.

Çözüldü Filtreleme Hakkında

yesimgurol

Ekli dosyalar

Ziynettin

Destek Ekibi

Ekli dosyalar

yesimgurol

yesimgurol

Ekli dosyalar

Ziynettin

Destek Ekibi

Ekli dosyalar

yesimgurol

yesimgurol

Ekli dosyalar

Erkan Akayay

yesimgurol

Ziynettin

Destek Ekibi

Ekli dosyalar

yesimgurol

Erkan Akayay

yesimgurol

yesimgurol

Ekli dosyalar

Ziynettin

Destek Ekibi

yesimgurol