Soru Listeleme kriterli

[kaos64]

Merhaba hocalarım
örnek dosyada isme göre listeleme yapabiliyorum yaptığım listelemeyi 2 tarih aralığındada listelemek istiyorum.
(Ben diğer sayfadan filitreleme yaptırabildim 2 tarih arası fakat isme göre gelmiyor artı baya yavaş oluyor)
birde veri almada active sayfaya değil alınan verinin örnekteki gibi sayfa 2 ye gelmesini istiyorum şimdiden teşekkür ederim.

Örnek

 

[Ziynettin]

Bu kodu deneyin.

Sub test()
Dim S1 As Worksheet, i As Long, S2 As Worksheet
Dim Trh1 As Date, Trh2 As Date, ISLEM As String
Set S1 = Sheets("Hisse")
Set S2 = Sheets("Filitre")
Application.ScreenUpdating = False
    Trh1 = S2.[B8]
    Trh2 = S2.[Q8]
    ISLEM = S2.[B5]
    a = S1.Range("A1:BD" & S1.Cells(Rows.Count, 1).End(3).Row).Value
    For i = 2 To UBound(a)
        If CDate(a(i, 1)) >= Trh1 And CDate(a(i, 1)) <= Trh2 Then
            If a(i, 2) = ISLEM Then
                say = say + 1
                For j = 1 To UBound(a, 2)
                    a(say, j) = a(i, j)
                Next j
            End If
        End If
    Next i
    S2.Range("A11:BD" & Rows.Count) = ""
    If say > 0 Then
        S2.[A11].Resize(say, UBound(a, 2)).Value2 = a
    End If
Application.ScreenUpdating = True
MsgBox "İşlem bitti.", vbInformation
End Sub

 

[Korhan Ayhan]

Kullandığınız gelişmiş filtre seçeneğini kullanabilirsiniz.

Görseldeki gibi ayarlarsanız "LİSTELE" isimli makronuz sonuç verecektir.

 

[kaos64]

Olmadı hocam
Kırmızıyla seçili kriterle göre olmasını isyorum listele makrosu çalışıyor işlem koduna göre listeledik sonra alttan listeyi 2 tarih arasında listeleyebilirmiyim teşekkürler.

 

[Ziynettin]

İşlem kodu için kod revize edildi. Tekrar deneyin.

 

[Korhan Ayhan]

Size HİSSE sayfasındaki hangi sütunlar lazım?

 

[kaos64]

hocam hepsini getirdim mecburen acemilikten mecburen gizledim fiyatlar hacim gibi bilgiler

 

[kaos64]

Korhan Hocam gelişmiş filitredeki indis formülünü paylaşabilirmisiniz. (tarih için)

 

[Korhan Ayhan]

Size tüm sütun bilgilerimi gerekiyor?

 

[kaos64]

Hocam gelişmiş filitre de tarih için kullandığınız eğerli formül paylaşabilirmisiniz.

 

[Korhan Ayhan]

Bu konuyla ilgili olarak linkteki video size ve diğer üyelerimize fayda sağlayacaktır.

 

[kaos64]

Korhan hocam tşk ederim video için

=EĞER($B$8="";">1";">"&$B$8)
=EĞER($Q$8="";"<60000";"<"&$Q$8)
şu şekilde yaptım ama filitreleme yapmadı sebebi neden olabilir hocam

 

[Korhan Ayhan]

Ben uyguladım ve olumlu sonuç aldım.

Size hangi sütunlar lazım dememdeki amaç buydu. Daha kolay bir şekilde uygulamak.

 

[kaos64]

hocam kriterler bunlar
TARIH1 - TARIH2 - ISLEM KODU - BULTEN ADI

bunlarda diğer taraftan çekilecek sutunlar

TARIH - ISLEM KODU - BULTEN ADI - ONCEKI KAPANIS FIYATI - ACILIS FIYATI - ACILIS SEANSI FIYATI - EN DUSUK FIYAT - EN YUKSEK FIYAT - KAPANIS FIYATI - KAPANIS SEANSI FIYATI - DEGISIM (%) - BEKLEYEN EN IYI ALIS - BEKLEYEN EN IYI SATIS - A.O.F - TOPLAM ISLEM HACMI - TOPLAM ISLEM ADEDI - TOPLAM SOZLESME SAYISI - ACILIS SEANSI ISLEM HACMI - ACILIS SEANSI ISLEM MIKTARI - ACILIS SEANSI SOZLESME SAYISI - KAPANIS SEANSI ISLEM HACMI - KAPANIS SEANSI ISLEM MIKTARI - KAPANIS SEANSI SOZLESME SAYISI - KAPANIS FIYATINDAN ISLEMLER ISLEM HACMI - KAPANIS FIYATINDAN ISLEMLER ISLEM MIKTARI - EN DUSUK ACIGA SATIS FIYATI - EN YUKSEK ACIGA SATIS FIYATI - ACIGA SATIS A.O.F - ACIGA SATIS ISLEM HACMI - ACIGA SATIS ISLEM ADEDI - ACIGA SATIS SOZLESME SAYISI

 

[Korhan Ayhan]

Bu kriterler doğrultusunda hangi sütunlar listelensin?

 

[kaos64]

hocam listelenecek sutunlar
A B C D Q R S T U V W X Y Z AB AC
tşkler hocam baya uğraştırdım sizi

 

[Korhan Ayhan]

Ekli dosyayı deneyiniz.

Ben dosya boyutunu küçültmek için verilerinizin bir kısmını silmek zorunda kaldım.

 

[kaos64]

Hocam çok tşk ederim. Elinize sağlık

 

[kaos64]

Korhan hocam
dosyaları içeri çektiğim makro var aldığı her dosyanın ismini veri sayfasına kaydediyor olmayan dosyayı içeriye alıyor.( Hayır seçtiğim zaman)
ben makroyu çalıştırdığımda filitre sayfasına alıyor verileri hisse sayfasına almak istiyorum rica etsem onada bakabilirmisiniz
veri dosyasını ekliyorum tşk ederim

 

[Korhan Ayhan]

"HİSSE" sayfasına aktarım yapmak için "Start" isimli prosedürü aşağıdaki kod ile değiştirip deneyiniz.

Sub Start()
    uyarı = MsgBox("Sayfayı temizlemek istiyormusunuz.?", vbYesNo + vbInformation, " Temizleme Penceresi")
    
    If uyarı = vbYes Then
    Range(Cells(10, 1), Cells(Rows.Count, Columns.Count)).Value = ""
    Sheets("veri").Range(Sheets("veri").Cells(1, 1), Sheets("veri").Cells(Rows.Count, Columns.Count)).Value = ""
    
    End If
    
    Sayfa_Adı = "Hisse"
    sut = Sheets(Sayfa_Adı).Cells(Rows.Count, 1).End(3).Row + 1
    deger1 = 0
    Sayfa_Adı2 = "veri"
    sonsat = ThisWorkbook.Sheets(Sayfa_Adı2).[a99999].End(3).Row
    
    Dim Dosya As String
    On Error Resume Next
    Dim Baslik As String
    Baslik = "Borsa İstanbul Bülten Aktarma Klasörü Seçiniz..!"
    Set Obj = CreateObject("shell.application")
    Set Klasor = Obj.browseforfolder(0, Baslik, 50, &H0)
    Kaynak = Klasor.Items.Item.path
    If Not Klasor Is Nothing Then
    If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
    On Error Resume Next
    Liste (Klasor.Items.Item.path)
    On Error Resume Next
    AltListe (Klasor.Items.Item.path)
    
    Liste7 (Klasor.Items.Item.path)
    AltListe9 (Klasor.Items.Item.path)
    Range("A1").Select
    MsgBox "Bilgiler Başarıyla Aktarılmıştır."
    
    Else
Atla:
    MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "Dikkat"
    End If
        
    Set Obj = Nothing
    Set Klasor = Nothing
    Exit Sub
Hata:
    MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
End Sub