• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Textbox'la Listboxa veri süzme yardım

A

aresos08

Katılım
26 Mayıs 2013
Mesajlar
9
Excel Vers. ve Dili
VBA
Ekteki dosyada dosya numarasına göre veri süzme yaptığımda excel takılıyor. sebebi ne olabilir?

Ben verileri arama yerine yazdıkça listboxda süzme yapacak daha iyi bir kod bilen varsa paylaşabilir mi?

Örneğin; lisxtbox'da ali
ayşe
Fatma
cevriye var

ben a yazdığımda ali ve ayşenin bulunduğu satır kalsın, al yazdığımda sadece ali kalsın

Şimdiden teşekkürler

[lnk=]http://www.dosya.tc/server9/ZM5xfj/SMMTAK_P.rar.html[/lnk]
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kodlarda bir şey yok siz sütun eklemiş olmayasanız.:cool:
Kod: 
Set k = .Range("[B][COLOR="Red"]D2:D65536[/COLOR][/B]").Find(TextBox16.Value & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To 4, 1 To a)
            For j = 1 To 4
                myarr(j, a) = .Cells(k.Row, j + 1).Value
            Next j
            Set k = Range([B][COLOR="Red"]"D2:D65536"[/COLOR][/B]).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox1.Column = myarr
    End If
 

Ekli dosyalar

Orion1' Alıntı:
Dosyanız ektedir.:cool:
Kodlarda bir şey yok siz sütun eklemiş olmayasanız.:cool:
Kod: 
Set k = .Range("[B][COLOR="Red"]D2:D65536[/COLOR][/B]").Find(TextBox16.Value & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To 4, 1 To a)
            For j = 1 To 4
                myarr(j, a) = .Cells(k.Row, j + 1).Value
            Next j
            Set k = Range([B][COLOR="Red"]"D2:D65536"[/COLOR][/B]).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox1.Column = myarr
    End If
Genişletmek için tıkla ...

Şu an yoldayım eve gidince ilk iş kontrol edeceğim. Garip olan şey aynı dosya evimdeki bilgisayarda sorunsuz veri süzüyor. Ofiste takıliyor. Sizden ikinci bir ricam rapor sayfasında smm toplami var. O hücre win8 yüklü bilgisayarda toplama yapmıyor. Sebebi ne olabilir? 10 günlük vba bilgimle işin içinden çıkamadım:)
 
aresos08' Alıntı:
Şu an yoldayım eve gidince ilk iş kontrol edeceğim. Garip olan şey aynı dosya evimdeki bilgisayarda sorunsuz veri süzüyor. Ofiste takıliyor. Sizden ikinci bir ricam rapor sayfasında smm toplami var. O hücre win8 yüklü bilgisayarda toplama yapmıyor. Sebebi ne olabilir? 10 günlük vba bilgimle işin içinden çıkamadım:)
Genişletmek için tıkla ...

Merhaba kontrol etme şansı buldum. Sizin yaptığınız düzeltme dosya numarasına göre değil isme göre arama.

Benim sorunum ise aynı dosyanın evde tıkır tıkır süzme yaparken ofisteki bilgisayarda excelin donması.

Ayrıca Rapor sayfasındaki topla formülü de garip bir şekilde win8 bilgisayarda çalışmıyor :(
 
aresos08' Alıntı:
Merhaba kontrol etme şansı buldum. Sizin yaptığınız düzeltme dosya numarasına göre değil isme göre arama.

Benim sorunum ise aynı dosyanın evde tıkır tıkır süzme yaparken ofisteki bilgisayarda excelin donması.

Ayrıca Rapor sayfasındaki topla formülü de garip bir şekilde win8 bilgisayarda çalışmıyor :(
Genişletmek için tıkla ...
Evet ada göre yaptım.Oysa siz dosya numarası istemi,şsiniz.
Ben şimdi tekrar eski haline getirdim.
Gayet güzel çalışıyor.
Dosyayı yolluyorum.deneyiniz.:cool:
 

Ekli dosyalar

Orion1' Alıntı:
Evet ada göre yaptım.Oysa siz dosya numarası istemi,şsiniz.
Ben şimdi tekrar eski haline getirdim.
Gayet güzel çalışıyor.
Dosyayı yolluyorum.deneyiniz.:cool:
Genişletmek için tıkla ...

Bendekinin aynısı :) Acaba ofisteki bilgisayarda arama yaparken neden donuyor olabilir. Artık donanımsal diyesim geliyor. Ofisteki bilgisayar evdekinden daha iyi bir makina olmasa... :)
 
aresos08' Alıntı:
Bendekinin aynısı :) Acaba ofisteki bilgisayarda arama yaparken neden donuyor olabilir. Artık donanımsal diyesim geliyor. Ofisteki bilgisayar evdekinden daha iyi bir makina olmasa... :)
Genişletmek için tıkla ...
Ofisteki bilgisayardaki işletim sistemi nedir.Ayrıca ofisin hangi versiyonudur?
 
aresos08' Alıntı:
win7 office 2010 - süzme işleminde exceli donduran bilgisayar
win8 office 2010 - toplama formülünü çalıştırmayan bilgisayar

İşin içinden çıkamadım :)
Genişletmek için tıkla ...
Bendede win7 ofis 2010 var.Gayet normal çalışıyor.Süzmeyi yapıyor.
Toplamayıda yapıyor.belki süzme yapamayan yerde çok veri vardır.Aklıma sadece bu geliyor.oradada buradaki gibi 1-2 satır veri girerek deneseniz!
Yada bu yolladığımı ayni olanı deneseniz!
 
Orion1' Alıntı:
Bendede win7 ofis 2010 var.Gayet normal çalışıyor.Süzmeyi yapıyor.
Toplamayıda yapıyor.belki süzme yapamayan yerde çok veri vardır.Aklıma sadece bu geliyor.oradada buradaki gibi 1-2 satır veri girerek deneseniz!
Yada bu yolladığımı ayni olanı deneseniz!
Genişletmek için tıkla ...

Çok veri olma ihtimalini denedim bugün. Şöyle bir sonuçla karşılaştım. Aynı dosya hiçbirşey değiştirmeden 1 tane kayıt girdim. Arama kutusuna "a" harfi yazdığımda hiç sorun olmadı. "2" yazdığımda kilitlendi. 2 hücrenin verisi 2 rakamı ile başlıyordu. Kafayı yiyecektim :)
 
aresos08' Alıntı:
Çok veri olma ihtimalini denedim bugün. Şöyle bir sonuçla karşılaştım. Aynı dosya hiçbirşey değiştirmeden 1 tane kayıt girdim. Arama kutusuna "a" harfi yazdığımda hiç sorun olmadı. "2" yazdığımda kilitlendi. 2 hücrenin verisi 2 rakamı ile başlıyordu. Kafayı yiyecektim :)
Genişletmek için tıkla ...
Ben şimdi 2 veriyede başalarına 2 girdim sorun çıkmadı.
 
Orion1' Alıntı:
Ben şimdi 2 veriyede başalarına 2 girdim sorun çıkmadı.
Genişletmek için tıkla ...

Evet benim evdeki bilgisayarda da çıkmıyor. Ofiste excel donuyor. Görev yöneticisinden kapatmak zorunda kalıyorum. Yarın yeni kodlarla deneyeceğim.

Kod: 
Private Sub TextBox16_Change()
    If TextBox16.Value = "" Then
    ListBox1.RowSource = "Data!B2:E" & Sheets("Data").[A65536].End(xlUp).Row
    Exit Sub: End If
    With Worksheets("Data")
        ListBox1.RowSource = ""
    For Each sat In Range("C2:C" & Range("C65536").End(3).Row)
        If UCase(LCase(sat)) Like UCase(LCase(TextBox16.Value)) & "*" Then
            With ListBox1
                sut = .ListCount
                .AddItem
                .List(sut, 0) = sat.Offset(0, -1).Value
                .List(sut, 1) = sat.Value
                .List(sut, 2) = sat.Offset(0, 1).Value
                .List(sut, 3) = sat.Offset(0, 2).Value
            End With
        End If
    Next sat
    End With
End Sub
 
Başka kod yazdım.
Onu da bir deneyin.
Bir tane suz sayfası yaptım.Süzülen verileri oraya getirip listboxa rowsource yöntemi ile alıyorum.
Dosya No olan sütunu metin olarak biçimlendiriniz.:cool:
Dosya ektedir.:cool:
Kod: 
Private Sub TextBox16_Change()
Dim sh As Worksheet, sat As Long
ListBox1.RowSource = ""
Sheets("Data").Select
Set sh = Sheets("Suz")
sh.Range("A1:G" & Rows.Count).Clear
Range("A1").AutoFilter
Range("A1").AutoFilter field:=3, Criteria1:=TextBox16.Text & "*"
Range("A2").CurrentRegion.Copy sh.Range("A1")
Range("A1").AutoFilter
ListBox1.RowSource = "Suz!A2:G" & sh.Cells(Rows.Count, "B").End(xlUp).Row
End Sub
 

Ekli dosyalar

Orion1' Alıntı:
Başka kod yazdım.
Onu da bir deneyin.
Bir tane suz sayfası yaptım.Süzülen verileri oraya getirip listboxa rowsource yöntemi ile alıyorum.
Dosya No olan sütunu metin olarak biçimlendiriniz.:cool:
Dosya ektedir.:cool:
Kod: 
Private Sub TextBox16_Change()
Dim sh As Worksheet, sat As Long
ListBox1.RowSource = ""
Sheets("Data").Select
Set sh = Sheets("Suz")
sh.Range("A1:G" & Rows.Count).Clear
Range("A1").AutoFilter
Range("A1").AutoFilter field:=3, Criteria1:=TextBox16.Text & "*"
Range("A2").CurrentRegion.Copy sh.Range("A1")
Range("A1").AutoFilter
ListBox1.RowSource = "Suz!A2:G" & sh.Cells(Rows.Count, "B").End(xlUp).Row
End Sub
Genişletmek için tıkla ...

Gerçekten harika. Yarın bu iki yöntemi de deneyeceğim. Sizin verdiğiniz örnek muhtemelen sorunsuz çalışacak :) Çok teşekkür ederim ilginize :) Yarın toplama işlemini neden yapmadığını bulabilirsem onu da buradan yazacağım. Hücrelerin biçimiyle alakalı olabilir diye düşünüyorum.
 
aresos08' Alıntı:
Gerçekten harika. Yarın bu iki yöntemi de deneyeceğim. Sizin verdiğiniz örnek muhtemelen sorunsuz çalışacak :) Çok teşekkür ederim ilginize :) Yarın toplama işlemini neden yapmadığını bulabilirsem onu da buradan yazacağım. Hücrelerin biçimiyle alakalı olabilir diye düşünüyorum.
Genişletmek için tıkla ...
Sayı görünümünde metin attıysanız yada o sütunu metin olarak biçimlendirdiyseniz toplama yapmaz.:cool:
 
aresos08' Alıntı:
Gerçekten harika. Yarın bu iki yöntemi de deneyeceğim. Sizin verdiğiniz örnek muhtemelen sorunsuz çalışacak :) Çok teşekkür ederim ilginize :) Yarın toplama işlemini neden yapmadığını bulabilirsem onu da buradan yazacağım. Hücrelerin biçimiyle alakalı olabilir diye düşünüyorum.
Genişletmek için tıkla ...

Toplama islemindeki sorun yeni tl simgesi ile alakali. Win8 yeni simgeye sahip excel de oyle algiliyor ancak toplamada haya veriyor. Hucre girisini sayi yaptm basliga da (TL) ekledim sorunu hallettim
 
aresos08' Alıntı:
Toplama islemindeki sorun yeni tl simgesi ile alakali. Win8 yeni simgeye sahip excel de oyle algiliyor ancak toplamada haya veriyor. Hucre girisini sayi yaptm basliga da (TL) ekledim sorunu hallettim
Genişletmek için tıkla ...
Sorunuzu çözdüğünüze sevindim.
İyi çalışmalar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst