• DİKKAT

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

listbox'ta farklı bir süzme

P

peleryn

Katılım
10 Mayıs 2009
Mesajlar
1,080
Excel Vers. ve Dili
2003 türkçe
Sevgili hocalarım,arkadaşlar;

Listboxa verilerin sütunlar halinde süzülmesi ile ilgili çok güzel örnekler gördüm sitede.Ancak benim ihtiyacım olan listboxta alışılagelen uygulamadan biraz farklı çalışan bir kısım var.sütun başlığının altındaki veriyi değilde verinin denk geldiği sütun başlığını değer olarak döndürüyor.Burada yeterli açıklamayı yapamayacağımı bildiğim için örnek bir dosya hazırladım.Yardımcı olursanız çok sevinirim.Şimdiden ilgilenen herkese çok teşekkür ederim.
 

Ekli dosyalar

Evren Hocam yine inanılmaz derecede hızlı ve çok güzel bir dosya yolladınız.bir fun clubınız olursa en ateşli üyelerinden biri olucam:)çok teşekkür ediyorum emeğiniz ve çözümünüz için.sadece rica edeceğim bir iki nokta var.ilki listboxta görüntülemeyi combobox_change olayının yapması,ikincisi ekle butonuna basıldığında LİSTE sayfasındaki veriler her seferinde silinip ekle dediğimiz öğeler geliyor.Bu şekilde değilde daha önce eklenmiş öğelerden sonraki ilk boş satırdan başlayıp ekleyebilir mi?son olarak bir ricam da şu örneğin "deniz" ismine bakarsanız aynı saat ve tarihe denk gelmiş mükerrer sayılabilecek bir kayıt göreceksiniz.listboxta böyle aynı saat ve tarihe denk gelen satırlar herhangi bir şekilde vurgulanabilir mi?ya da olmaz derseniz bir başka şey rica etçem:)tabi eğer "sen de iyi alıştın istemeye ama " demezseniz:)
 
Dosyanız ekte.
Son isteğiniz için listboxta renklendirme olmuyor biliyorsunuz.Belki çoklu seçim ile bu satırlar ilk başta seçili olurlar ama başka bir tane seçildiğinde karışıklık olur.Birde budurum ukabul etseniz bile listboxta listeleme olayı uzun süre alabilir.
Ben onu size tavsiye etmiyorum.
Kolay gelsin.:cool:
 

Ekli dosyalar

Evren Hocam gerçekten harika oldu işlerimizi o kadar kolaylaştıracak ki sadece teşekkür etmek çok yetersiz kalıyor memnuniyetimi anlatmaya.süratinize olan hayretimse sanırım hiç azalmayacak..
hocam bir önceki mesajda da söylemiştim öyle olmazsa bir ricam olacak diye.
konu şuydu:dersleri dağıttığımız seanslar sayfasında bu mükerrer kayıtların önüne geçmek için
c2:j534 aralığında isim-tarih ve saatin aynı olduğu bir kayıt oluşması halinde msgboxla uyarsın ve aynılığı doğuran diğer kayıtı mümkünse bu mesajda versin.
buna ek olarak bu dosya için bir daha birşey istememek üzere birşey daha rica edeceğim:
m2 hücresine gireceğim bir sayısal değer olacak bu yazılabilecek en çok ders sayısıdır. m2 hücresindeki bu değeri şöyle yorumlayacak :c2:j218 (218 doğrudur kırmızı alanı saymıyorum)aralığında bu isim için şimdi girilen kayıt m2 den fazla olmasına neden oluyorsa msg=m2'den fazla seans yazamazsınız.
n2 hücresine gireceğim sayısal değer de farklı bir sayısal değer olacak bu değerin yorumu da ;
c225:j534 aralığında bu isim için şimdi girilen kayıt n2 den fazla olmasına neden oluyorsa msg=n2'den fazla seans yazamazsınız olacak.

hocam bu eklemeleri de yapabilirseniz çok daha mutlu olmamı sağlayacaksınız.Ve bu dosyayla uğraşmaktan uzun bi süre daha sizi yormayacağım.Umarım yardımcı olursunuz şimdiden tekrar teşekkürler.
 
Hocam en kısa zamanda ilgileneceğinizi biliyordum.ne yapıp edip geldim gerçekten de dosyam hazırdı teşekkür ederim.
sanıyorum sayfa her hareketimde tüm hücreleri hesapladığı için dosyam çok ağır işliyor.bir de sanırım mesajımda açıkça anlatamamışım ki yanlış bir uygulama ile uğraşmanıza neden oldum özür diliyorum.
daha açık şöyle anlatayım.m2 hücresine misal 6 yazalım.6 şu demek diyelimki DİLAN isimli öğrenciyi saatlere dağıtıyorum.makro m2 ile kıyaslayacak ve dilan ismi 6 yı geçerse uyarı verecek ve bu tüm isimler için geçerli.n2 de aynen böyle işliyor.
bir de diğer mesaj olayı var o da şuna bağlı :yine misal DİLAN ismi 11.08.2009 09:00 a bir uzmana yazılmış.aynı saat ve tarihe bir başka uzmana yazılmaya kalkılırsa uyarı versin..ikinci mesajı tetikleyen olay da bu.

bunları yazıyorum ama düzeltmeleri yapmazsanız da ilk haliyle zaten gayet güzel bir çalışma yaptınız benim için.tekrar teşekkür ederim.

eğer ki bu son haline getirmek isterseniz ve yine böyle yavaş işleyecekse bu durumda benim işimi görmeyecek ve boşa emeğinizi harcatmak istemem.bu durumda benim ihtiyacım şu olacak.sayfa üzerinde bir butona basayım ve bana bir rapor hazırlasın.İÇERİK ŞU:1.si m2 deki koşulu geçenler 2.si n2 deki koşulu geçenler ve son olarak ta aynı saat ve tarihte farklı uzmanlara yazılanlar.

tüm emekleriniz,bana tahsis ettiğiniz zamanınız ve sabrınız için tekrar teşekkürler.
 
Evren Bey;
Ekte gönderdiğim dosyamda göreceğiniz üzere normalde bahsettiğim ilk iki problemi koşullu biçimlendirme kullanarak m2 ve n2 deki değerlerin altında ve üstünde olanları işaretleme şeklinde dosyamı kullanıyorum.daha iyi bir öneriniz olmazsa hazırlamış olduğunuz listbox sayesinde tablonun yükü benim için bayağı azalmış durumda.Çözülmesine ihtiyaç duyduğum tek problem olarak aynı saat ve tarihte farklı uzmanlara bir öğrencinin isminin birden fazla kere yazılmasını denetleme sorunum kalıyor.(c2:j534 aralığında)Bunun için Doğrulama/Özel işlevini kullanabileceğimi düşünmüştüm ama ne yaptımsa formüle edemedim.Bu sorunu çözmeniz benim için yeterli olacak ilgi ve desteğiniz için tekrar teşekkürler.
 

Ekli dosyalar

Merhaba.
Vallahi ne oldu bende bilmiyorrum.O son yolladığım dosyaya bir şeyler oldu.
Ağır çalışıyordu ,ama bu kodlardan kaynaklanmıyordu.
Şimdi son isteğinizi veri doğrulama ile yaptım.
Dosya ektedir.:cool:
 

Ekli dosyalar

Evren Hocam;
Dosyam bu son haliyle tüm ihtiyaçlarımı karşılayacak hale geldi hem de sayenizde bir gecede.iyi ki bu siteyle ve sizinle karşılaştım.yardımlarınız için çok teşekkür ederim.
 
peleryn' Alıntı:
Evren Hocam;
Dosyam bu son haliyle tüm ihtiyaçlarımı karşılayacak hale geldi hem de sayenizde bir gecede.iyi ki bu siteyle ve sizinle karşılaştım.yardımlarınız için çok teşekkür ederim.
Genişletmek için tıkla ...
Rica ederim.
Bunu saymayız.
Yine bekleriz. :D
 
Evren Hocam öncelikle Mrb....

listbox'ta farklı bir süzme çalışmanı incelediğimde banada yapmış olduğum Evrak ve Arşiv takip sistemim için peleryn' e yaptığın işleme benzer sütunlarda arama yapacak kod uygulamasına ihtiyacım var. Yardımlarınız için şimdiden şükranlarımı sunuyorum.

Örnek çalışma Ektedir....
 

Ekli dosyalar

Ömer bey dosyanız ekte.
En hızlı süzme yapacak şekilde kodları yazdım.
Tarihlerde dahil tarih sütununa kadar ben kodları yazdım.
Eminimki bundan sonraki sütunları siz yazacak durumdasınız.
SUZ sayfası ekledim.Bu sayfaya aktarılıp listboxa veriler alınmaktadır.
Kolay gelsin.:cool:
Kod: 
Sub suz()
Dim tur As String, ilk As Date, son As Date, sh As Worksheet
On Error Resume Next
If ComboBox1.Value = "" Or ComboBox1.Value = "HEPSİ" Then
    tur = "*"
    Else
    tur = ComboBox1.Value
End If
Set sh = Sheets("SUZ")
sh.Range("A1:S65536").ClearContents
With Sheets("Sayfa1")
    If TextBox262.Text = "" Then
        ilk = CDate(WorksheetFunction.Min(.Range("F2:F65536")))
        Else
        ilk = CDate(TextBox1.Text)
    End If
    If TextBox263.Text = "" Then
        son = CDate(WorksheetFunction.Max(.Range("F2:F65536")))
        Else
        son = CDate(TextBox263.Text)
    End If
    .Range("A1").AutoFilter
    .Range("A1").AutoFilter field:=2, Criteria1:="=" & TextBox1.Text & "*"
    .Range("A1").AutoFilter field:=3, Criteria1:="=" & TextBox260 & "*"
    .Range("A1").AutoFilter field:=4, Criteria1:="=" & tur & "*"
    .Range("A1").AutoFilter field:=5, Criteria1:="=" & TextBox261.Text & "*"
    .Range("A1").AutoFilter field:=6, Criteria1:=">=" & CDbl(ilk), Operator:=xlAnd, Criteria2:="<=" & CDbl(son)
    'Buradan sonrasına siz devam edin
    
    .Range("A1:S" & .Cells(65536, "A").End(xlUp).Row).CurrentRegion.Copy sh.Range("A1")
    .Range("A1").AutoFilter
    ListBox1.RowSource = "SUZ!A2:S" & sh.Cells(65536, "A").End(xlUp).Row
End With
End Sub
 

Ekli dosyalar

Evren hocam;

Bu dosyadaki çözümünüzle hazırladığım dosya o kadar çok işimi görüyor ki ne kadar teşekkür etsem az.

Şimdi bu dosyadaki userforma "Tümünü Ekle" adında bir buton ekleme ihtiyacım var.Butona tıklandığında LİSTE adlı sayfada 2. satırdan sonrasını temizleyecek ve comboboxta bulunan tüm isimlere ait kayıtları listboxta aldığı kriterleri baz alarak listboxta hiç görüntülemeden direkt LİSTE sayfasına ekleyecek.

Yani tek tek ismi seçip ekle butonuna basarak yaptığım işi comboboxtaki tüm isimler için tek tuş yapacak.

Evren hocam ve diğer hocalarımdan konuyla ilgilenen olursa çok sevinirim.
 

Ekli dosyalar

peleryn' Alıntı:
Evren hocam;

Bu dosyadaki çözümünüzle hazırladığım dosya o kadar çok işimi görüyor ki ne kadar teşekkür etsem az.

Şimdi bu dosyadaki userforma "Tümünü Ekle" adında bir buton ekleme ihtiyacım var.Butona tıklandığında LİSTE adlı sayfada 2. satırdan sonrasını temizleyecek ve comboboxta bulunan tüm isimlere ait kayıtları listboxta aldığı kriterleri baz alarak listboxta hiç görüntülemeden direkt LİSTE sayfasına ekleyecek.

Yani tek tek ismi seçip ekle butonuna basarak yaptığım işi comboboxtaki tüm isimler için tek tuş yapacak.

Evren hocam ve diğer hocalarımdan konuyla ilgilenen olursa çok sevinirim.
Genişletmek için tıkla ...

Comboboxta TÜMÜ seçeneğini seçiniz.:cool:
Dosya ektedir.:cool:
Kod: 
Private Sub isimler_Change()
Dim hcr As Range, x As Long, deg As Variant
liste.Clear
If isimler.Value = "HEPSİ" Then Sheets("LİSTE").Range("A2:F65536").ClearContents
For Each hcr In Range("C2:J534")
    If isimler.Value <> "HEPSİ" Then
        deg = UCase(Replace(Replace(isimler, "ı", "I"), "i", "İ"))
        Else
        deg = UCase(Replace(Replace(hcr.Value, "ı", "I"), "i", "İ"))
    End If
    If UCase(Replace(Replace(hcr.Value, "ı", "I"), "i", "İ")) = _
    deg And UCase(Replace(Replace(hcr.Value, "ı", "I"), "i", "İ")) <> "" Then
    liste.AddItem
    liste.List(x, 0) = hcr.Value
    liste.List(x, 1) = Format(Cells(hcr.Row, "A").Value, "dd.mm.yyyy")
    liste.List(x, 2) = Cells(1, hcr.Column).Value
    If hcr.Row <= 224 Then
        liste.List(x, 3) = "BİREYSEL"
        Else
        liste.List(x, 3) = "GRUP"
    End If
    liste.List(x, 4) = Cells(hcr.Row, "K").Value
    liste.List(x, 5) = Cells(hcr.Row, "L").Value
    x = x + 1
    End If
Next
listeler = liste.List
liste.List = sirala(listeler, 2)
listeler = liste.List
liste.List = sirala(listeler, 1)
Label1.Caption = "Listelenen : " & liste.ListCount
End Sub
 

Ekli dosyalar

Evren hocam yine harikasınız kodlarınız da harika sayenizde hazırladığım dosyalar da harika..Ne desem az valla ellerinize sağlık çok teşekkür ederim.
 
peleryn' Alıntı:
Evren hocam yine harikasınız kodlarınız da harika sayenizde hazırladığım dosyalar da harika..Ne desem az valla ellerinize sağlık çok teşekkür ederim.
Genişletmek için tıkla ...
Rica ederim.
O sizin harikalığınız.:cool:
 
Bu konudaki son dosyaya ek olarak listede listelenen satırlardan birisine çift tıkladığımda o bilgilerin alındığı satırdaki ismin yazılı olduğu hücrenin sayfada seçilmesine çalıştım yapamadım.Yardımcı olan olursa sevinirim..
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst