Filtrelenen verilerde FIND komutu

[AlpGD]

Merhaba, 2 sorum olacak ;

1. Bir sayfada tarih aralığına göre süzme işlemi yapıyor, daha sonra bu süzülen verileri bir combobox veya listbox a çağırmak istiyorum. Oysa verileri çağırdığımda süzülen veriler değil bütün veriler geliyor. Sadece filtrelenen veriler üzerinde işlem yapmanın, süzülen sayfayı kopyalatmak haricinde pratik bir yolu var mı ?

2. Yine süzme işlemi yapıldıktan sonra FIND komutunu bu veriler üzerinde kullanmak istiyorum fakat filtre sonuçları değil de tüm veriler üzerinde arama yapıyor. Sadece filtrelenen veriler arasında FIND komutunu kullanabilir miyim?

Sanırım ikisinin çözümü de aynı metod ile oluyor (şayet varsa)

Teşekkürler ...

 

[Evolver]

kodlarınızı buraya yazmadığınız için sadece tahmin yürütebiliyorum.
arama yaptığınız satırı, Cells.SpecialCells(xlCellTypeVisible).Find(.........) şeklinde değiştirseniz istediğiniz şey olurmu acaba.

 

[Korhan Ayhan]

Selamlar,

1. Sorunuz için dizi yöntemini kullanırsanız oldukça hızlı sonuçlara ulaşabilirsiniz. Aşağıdaki kod filtre uygulanmış A sütunundaki görünen hücreleri ComboBox nesnesin yükler. Yaklaşık 60.000 veri üzerinde denediğimde 2-3 saniye sürüyor.

Option Explicit
 
Private Sub UserForm_Initialize()
    Dim Veri As Variant, X As Long, Satır As Long
    
    ComboBox1.RowSource = ""

    ReDim Veri(1 To 1, 1 To Range("A65536").End(3).Row)
    
    For X = 2 To Range("A65536").End(3).Row
        If Rows(X).RowHeight > 0 Then
        Satır = Satır + 1
        ReDim Preserve Veri(1 To 1, 1 To Satır)
        Veri(1, Satır) = Cells(X, 1)
        End If
    Next
    
    ComboBox1.Column = Veri
End Sub

2. Sorunuz için filtre uygulanmış alanda find komutunu denediğimde aradığım veri gizli satırda olmasına rağmen görünen satırdaki veriyi buldu. Yani sizin bahsettiğiniz gibi gizli satırlardaki veriyi bulmadı.

 

[Orion1]

Süzülen veriyi aşağıdaki kodla başka bir sayfaya atıp oradan listboxa veya comboboxa rowsource yöntemi ile hızlı bir şekilde alabilirsiniz.
Diğer sorunuz için süzülen verinin bulunduğu sütunu yeni bir sorgu ile çözmek sorunu halleder.

Range("A1").CurrentRegion.Copy Sheets("Sayfa2").Range("A1")

 

[AlpGD]

Öncelikle Evren ve Korhan üstadlar, cevaplar için teşekkür ederim. Özellikle Korhan beyin msnden de zaman buldukça ufak tefek soruları yanıtlaması sayesinde 2-3 tane bayağı komplike macro yazabildim.
Sayfa kopyalatarak yapabiliyorum. Yani şu anda da öyle kullanıyorum zaten. Fakat birçok data sayfası olduğu için kopyalatmak sorun olmaya başladı.
SpecialCell komutunu daha önce denedim fakat hata verdi
Korhan hocamın 1. sorum için verdiği örneği deneyip sonucunu yazarım. Kodları sayfa kopyalamaya göre düzenlemiştim.

2. Find komutunu çok denedim fakat her seferinde tüm hücrelerde arama yaptı. Hatta CTRL+F ile bu komutu çalıştırdığımızda filtrelenen verilerde ara diye bir seçenek olmadığından ben de vazgeçmiştim. Kodları tekrar kontrol edip bir daha deneyecem.

Tekrar teşekkürler.

 

[Orion1]

Aslında bir tane örnek dosya yollasanız hiç bu kadar yazışmaya gerek olmayacak.
Üzerinde yapıp yollayacaz.Dosyanın aynisini yollamayın ama ona benzer örnek yolayın.
Veya içindeki verileri silin uyduruk veriler koyun 2003 formatında ekleyin.
Dosyanın üzerindede açıklama koymayı unutmayın.
İşlem aslında çok basit.Siz yapamıyorsunuz.

 

[AlpGD]

Evren bey, haklısınız; normalde örnek kod veya dosya olmadan soru sormam fakat burada ben işin mantığında mı bir hatam var diye sormuştum daha çok.
Konuyla ilgili formdan gereksiz alanları, kodları ve sayfaları elimden geldiğince temizledim. Sorunu da userform1 de belirttim.
Ayrıca benim bilmediğim de doğru Basit olduğunu da tahmin edebiliyorum.
Hatta geçmişte yaptığım çalışmaları incelesem oradan da çözümü bulurum belki. Fakat forumda bununla ilgili arama yapıp bulamayınca belki katkısı olur düşüncesiyle başlık açtım.

Son olarak site ve buradaki insanların emeğine saygım sonsuz, o nedenle yanlış algılanmasın; fakat sitenin arama motoru (tabi ki forum standartlarında bir arama özelliği) biraz daha geliştirilebilir veya google ile site araması kutucuğu üstte bir yere eklenebilir ise tahminimce birçok konu boşuna açılmamış olacaktır. Unutmadan, şu 30 saniye kısıtlamasını kaldırabilirseniz çok iyi olacak
[Neden bırakıldığını biliyorum, bundan ötürü açıklama yapmanıza gerek yok]

Saygılar ve ilgilenen herkese tekrar teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Kullandığınız kodu aşağıdaki şekilde değiştirip denermisiniz.

Private Sub lstFlm_Click()
txtFa = lstFlm.Text
Set film = Worksheets("FILMLER")
Dim Fara As Range, Tara As Range
Set Tara = film.Range("b1:b65536").Find(CDate(txtPTarih.Value))
If Tara Is Nothing Then
    film.Range("A1").AutoFilter Field:=2, Criteria1:=CDate(txtPTarih.Value) - 1
Else
    film.Range("A1").AutoFilter Field:=2, Criteria1:=CDate(txtPTarih.Value)
End If
Set Fara = film.Range("c2:c65536").SpecialCells(xlCellTypeVisible).Find(txtFa.Text)
If Fara Is Nothing Then Exit Sub
Frame9.Visible = True
cboSa = Fara.Offset(0, 1)
cboSeans = Fara.Offset(0, 2)
TextBox3 = Fara.Address
If Fara.Offset(0, 3).Text = "Salon 1" Then OptionButton1 = True
If Fara.Offset(0, 3).Text = "Salon 2" Then OptionButton2 = True
If Fara.Offset(0, 3).Text = "Salon 3" Then OptionButton3 = True

txtSaat1 = Format(Fara.Offset(0, 4), "hh:mm")
txtSaat2 = Format(Fara.Offset(0, 5), "hh:mm")
txtSaat3 = Format(Fara.Offset(0, 6), "hh:mm")
txtSaat4 = Format(Fara.Offset(0, 7), "hh:mm")
txtSaat5 = Format(Fara.Offset(0, 8), "hh:mm")
txtSaat6 = Format(Fara.Offset(0, 9), "hh:mm")
txtSaat7 = Format(Fara.Offset(0, 10), "hh:mm")
End Sub

 

[AlpGD]

Selamlar,

Kullandığınız kodu aşağıdaki şekilde değiştirip denermisiniz.

Private Sub lstFlm_Click()
txtFa = lstFlm.Text
Set film = Worksheets("FILMLER")
Dim Fara As Range, Tara As Range
Set Tara = film.Range("b1:b65536").Find(CDate(txtPTarih.Value))
If Tara Is Nothing Then
    film.Range("A1").AutoFilter Field:=2, Criteria1:=CDate(txtPTarih.Value) - 1
Else
    film.Range("A1").AutoFilter Field:=2, Criteria1:=CDate(txtPTarih.Value)
End If
Set Fara = film.Range("c2:c65536").SpecialCells(xlCellTypeVisible).Find(txtFa.Text)
If Fara Is Nothing Then Exit Sub
Frame9.Visible = True
cboSa = Fara.Offset(0, 1)
cboSeans = Fara.Offset(0, 2)
TextBox3 = Fara.Address
If Fara.Offset(0, 3).Text = "Salon 1" Then OptionButton1 = True
If Fara.Offset(0, 3).Text = "Salon 2" Then OptionButton2 = True
If Fara.Offset(0, 3).Text = "Salon 3" Then OptionButton3 = True

txtSaat1 = Format(Fara.Offset(0, 4), "hh:mm")
txtSaat2 = Format(Fara.Offset(0, 5), "hh:mm")
txtSaat3 = Format(Fara.Offset(0, 6), "hh:mm")
txtSaat4 = Format(Fara.Offset(0, 7), "hh:mm")
txtSaat5 = Format(Fara.Offset(0, 8), "hh:mm")
txtSaat6 = Format(Fara.Offset(0, 9), "hh:mm")
txtSaat7 = Format(Fara.Offset(0, 10), "hh:mm")
End Sub

Korhan bey, çok teşekkür ederim. Specialcells komutunu range olarak vermiştim fakat muhtemelen yanlış yazdım yahut aralık farklıydı ki ben yapınca olmadı. Tam olarak aradığım buydu zaten örnekte o kodu Evolver adlı arkadaşın önerisiyle de tekrar deneyip, kapattığımı göreceksiniz fakat tanımlama eksik kalmış.

Selamlar,

1. Sorunuz için dizi yöntemini kullanırsanız oldukça hızlı sonuçlara ulaşabilirsiniz. Aşağıdaki kod filtre uygulanmış A sütunundaki görünen hücreleri ComboBox nesnesin yükler. Yaklaşık 60.000 veri üzerinde denediğimde 2-3 saniye sürüyor.

Option Explicit
 
Private Sub UserForm_Initialize()
    Dim Veri As Variant, X As Long, Satır As Long
    
    ComboBox1.RowSource = ""

    ReDim Veri(1 To 1, 1 To Range("A65536").End(3).Row)
    
    For X = 2 To Range("A65536").End(3).Row
        If Rows(X).RowHeight > 0 Then
        Satır = Satır + 1
        ReDim Preserve Veri(1 To 1, 1 To Satır)
        Veri(1, Satır) = Cells(X, 1)
        End If
    Next
    
    ComboBox1.Column = Veri
End Sub

2. Sorunuz için filtre uygulanmış alanda find komutunu denediğimde aradığım veri gizli satırda olmasına rağmen görünen satırdaki veriyi buldu. Yani sizin bahsettiğiniz gibi gizli satırlardaki veriyi bulmadı.

Bu arada daha önceden sorduğum ilk soru için verdiğiniz kodu uyarlayıp aşağıdaki şekilde kullandım sorunsuz bir şekilde çalıştı.

Private Sub FilmTarihiBul()
Set film = Worksheets("FILMLER")

film.AutoFilterMode = False

film.Range("A1").AutoFilter Field:=3, Criteria1:=lstFlm.Text
film.Select

Dim say2 As Long
For say2 = 1 To Range("B65536").End(xlUp).Row
If Range("B" & say2) = "" And Range("B" & say2 + 1) = "" Then
Range("B" & say2) = WorksheetFunction.CountA(Range(Range("B" & say2 + 2), _
Range("B" & Range("B" & say2 + 2).End(xlDown).Row)))
End If
Next say2

Dim Veri As Variant, G As Long, Satır As Long
ReDim Veri(1 To 1, 1 To Range("B" & say2).End(3).Row)
For G = 2 To say2
If Rows(G).RowHeight > 0 Then
Satır = Satır + 1
ReDim Preserve Veri(1 To 1, 1 To Satır)
Veri(1, Satır) = Cells(G, 2)
End If
Next

lstTrh.Column = Veri
lstTrh.ColumnWidths = 28
lstTrh.ColumnHeads = False

With film
say = .AutoFilter.Range.Rows.SpecialCells(xlCellTypeVisible).Count / .AutoFilter.Range.Columns.Count - 1
End With

lblGun = say & " Gün"

film.AutoFilterMode = False

End Sub

Tekrar teşekkür ediyorum. Saygılar ...