Texbox ile süzme işlemi

[adobul]

Merhaba,

Excel'de satınalma çalışmalarımda kullanmak üzere ekteki örnek dosyayı oluşturdum. Ancak tüm araştırmalarıma rağmen bulamadığım bir sorunum var. Textbox ile süzgeç makrosu işimi şimdilik görüyor, fakat listedeki satır sayısı arttıkça süzme işlemi gitgide uzamaya ve bilgisayarı kasmaya başladı. Bu haliyle makro texboxa her girdiğim değere göre süzme işlemini tekrarlama yaptırıyor. Bunun yerine istediğim veriyi tam ya da eksik yazıp texboxtaki veriye göre bu süzme işlemini 'enter' sonrası başlatmak istiyorum. Makroyu entere bastıktan sonra çalışmasını sağlayabilir miyim?

Bu bilgi düzeyimi aşdığı için yardımlarınızı bekliyorum..

 

[Merhum İdris SERDAR]

.

Buraya bakın.

http://www.excel.web.tr/f133/metin-kutusu-textbox-ile-bazy-veri-turlerini-suzme-t16264.html

.

 

[adobul]

Sn.Yurttaş hocam sorunum tam anlaşılmadı sanırım. Verdiğiniz link lerdeki örnekleri yaptığım çalışmada uyguladım zaten. Cevabını bulamadığım, süzme işleminin texboxa veri girerken değil de giriş tamamlandıktan sonra enter'e bastıktan sonra yapmasını sağlamak. Mevcut Koda ilave bir komut da olabilir diye düşündüm ama araştırmamdan sonuç alamadım. Aslında isteğim basit ama listemin satır sayısı arttıkça önem arz ediyor.

Başka fikri olanlar varsa yardım bekliyorum..

 

[adobul]

Merhaba;

İsteğimin çok zor olduğunu sanmıyorum, yanılmışım... cevap bulmam zor olacak sanırım...

 

[halit3]

Merhaba;

İsteğimin çok zor olduğunu sanmıyorum, yanılmışım... cevap bulmam zor olacak sanırım...

Bu textbox1 e çift tıklama ile çalışıyor

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
METİN2 = TextBox1.Value
Set FC2 = Range("A4:O1000000").Find(What:=METİN2)
Application.GoTo Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter Field:=1, Criteria1:=TextBox1.Value & "*"
If METİN2 = "" Then
Selection.AutoFilter Field:=1
End If
End Sub

Buda textbox1 den çıkınca çalışıyor.

Private Sub TextBox1_LostFocus()
On Error Resume Next
METİN2 = TextBox1.Value
Set FC2 = Range("A4:O1000000").Find(What:=METİN2)
Application.GoTo Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter Field:=1, Criteria1:=TextBox1.Value & "*"
If METİN2 = "" Then
Selection.AutoFilter Field:=1
End If
End Sub

 

[Korhan Ayhan]

Merhaba,

Alternatif olarak aşağıdai kodları kullanabilirsiniz.

Kendi dosyanızdaki kodu silip aşağıdaki kodları uygulayınız.

Aranan değeri yazıp ENTER tuşuna bastığınızda filtre uygulanır. Nesneyi boşalttığınızda tüm veriler gösterilir.

Private Sub TextBox1_Change()
    On Error Resume Next
    If TextBox1 = "" Then ActiveSheet.ShowAllData
End Sub
 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        On Error Resume Next
        METİN2 = TextBox1.Value
        Set FC2 = Range("A4:O1000000").Find(What:=METİN2)
        Application.GoTo Reference:=Range(FC2.Address), _
        Scroll:=False
        Selection.AutoFilter Field:=1, Criteria1:=TextBox1.Value & "*"
        If METİN2 = "" Then
        Selection.AutoFilter Field:=1
        End If
    End If
End Sub

 

[hımmmmmmmm]

slm

kotları textbox'un afterupdate olayına yaz...

 

[adobul]

Emeği geçen herkese teşekkür ederim.. İstediğimden fazla seçenek çıktı, Korhan hocam tam düşündüğüm kodu vermişsiniz elinize sağlık Halit hocam gönderdiğiniz kodu başka bir uygulamamda değerlendirebilirim mutlaka ...

Saygılarımla...

 

[adobul]

Korhan hocam merhaba,

Bir konuda daha sizden fikir alabilir miyim?

Çalışmamda kullandığım formülü ( =DÜŞEYARA("IISI-"&A493;ParçaBilgi!A:B;2;YANLIŞ ) her satırda tekrarlıyorum. Satır sayısı artıkça dosya boyutu da hızla büyüyor...Bunu bir kod yardımıyla yapmam mümkün müdür?

 

[adobul]

Merhabalar,

Aynı örnek üzerinde yeni bir soru sormuştum cevap alamadım.. Yeni konu mu açmalıydım ? Bu konuda yardımı olabilecek yok mudur?

Teşekkürler...

 

[Korhan Ayhan]

Merhaba,

Evet mümkündür.

Formülü uygulayacağınız hücre aralığını belirtirseniz yardımcı olabilirim.

Ya da ben size örnek kodu veriyim siz kendi dosyanıza uyarlayın.

Aşağıdaki kod ilgili sayfanın K2:K1000 aralığına belirttiğiniz formülü uygular ve değere çevirir. Böylece dosyanız boyut olarak çok fazla şişmez.

Option Explicit
 
Sub FORMÜL_UYGULA()
    With Range("K2:K1000")
        .Formula = "=VLOOKUP(""IISI-""&A2,PARÇABİLGİ!A:B,2,FALSE)"
        .Value = .Value
    End With
End Sub

 

[adobul]

Sayın Korhan Hocam,

Kod için teşekkürler..ancak denemelerimde sonuç alamadım. İstediğimi tekrar kısaca anlatmaya çalışayım... A sütununda sırayla giriş yapılan kodların karşılığını bulan B sütunundaki formülün işini yapacak olan bir kod gerekiyor. A sütununda eğer hücre doluysa onun karşılığını formülle düşey ara yaparak bulabiliyorum. Buna gerek kalmadan kodla bu işi yapmak istiyorum.. Basit olarak açıklamaya çalıştığım örnek dosya ektedir.

Umarım açıklayıcı olmuşumdur.. Teşekkürler..