Combobox dan seçime göre listeleme

[sdegirmenci]

Merhaba;
Combo1 de seçmiş olduğum verinin depo sayfasında karşılık gelen bilgilerinin aynı sayfadaki tabloya sıralanması ile ilgili Combo altında, bu forumdan siz Hocalarımın yazmış olduğu kod mevcut, Başka yerlerde bu kodu yazarak çok faydalandım ancak burada hata vermekte; Yardımcı olabilirseniz çok sevinirim; Saygılarımla.

 

[Ömer]

Merhaba,

Bu şekilde deneyiniz.

Private Sub ComboBox1_Change()
 
Dim c As Range, sat As Long, ilkadres As Variant, Sd As Worksheet
 
Application.ScreenUpdating = False
 
Set Sd = Sheets("DEPO")
Range("C16:P" & Rows.Count).ClearContents
 
sat = 15
With Sd.Range("C:C")
    Set c = .Find(ComboBox1.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        ilkadres = c.Address
        Do
            sat = sat + 1
            Cells(sat, "C") = sat - 15             'SIRA NO
            Cells(sat, "D") = Sd.Cells(c.Row, "F") 'TAHAKKUK TARİHİ
            Cells(sat, "E") = Sd.Cells(c.Row, "H") 'MİKTARI
            Cells(sat, "F") = Sd.Cells(c.Row, "P") 'FİYAT FARKI
            Cells(sat, "G") = Sd.Cells(c.Row, "J") 'TOPLAM
            Cells(sat, "H") = Sd.Cells(c.Row, "I") 'KDV
            Cells(sat, "I") = Sd.Cells(c.Row, "N") 'GENEL TOPLAM
            Cells(sat, "J") = Sd.Cells(c.Row, "L") 'STOPAJ
            Cells(sat, "K") = Sd.Cells(c.Row, "M") 'DAMGA VERG.
            Cells(sat, "L") = Sd.Cells(c.Row, "Q") 'TEMİNAT.
            Cells(sat, "M") = Sd.Cells(c.Row, "R") '%30
 
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> ilkadres
    End If
End With
 
Application.ScreenUpdating = True
 
End Sub

.

 

[sdegirmenci]

Merhaba,
Çok değerli Ömer Hocam, Öncelikle ilginize çok teşekkür ederim, Yazmış olduğunuz kodu uyguladım, Çalışıyor, ancak çok yavaş ve tek tek listelemekte, ekteki dosyam üzerinde mevcut olan kod ile bir çırpıda hepsini listelemekte idi, acaba daha hızlı olması mümkğnmü?

 

[Ömer]

Yavas olacağını sanmıyorum. En azında hata var dediğiniz koddan farkı yok, iki kodda da find kullanıldı. Sizinki yavaşsa benimkide yavaştır, sizinki hızlıysa benimkide hızlıdır.

Application.ScreenUpdating = False

satırınız eklerseniz ekran görüntülerini almazsınız ve daha hızlı olur. Koda ekledim.

Hepsiniden kastınız nedir. Combobox dan seçtiğiniz veriyi listeliyor. Sizin yapmak istediğiniz bu değil mi?

 

[sdegirmenci]

ek

Hocam sizi yoruyorum özür dilerim, hepsinden kastım tüm listeyi bir anda 1 saniye gibi kısa sürede listelemekti, Ekte ki dosyam üzerinde Rapor sayfasındaki Combo dan seçim yaparsanız ne demek istediğimi anlayabilirsiniz.

 

[Ömer]

Hocam sizi yoruyorum özür dilerim, hepsinden kastım tüm listeyi bir anda 1 saniye gibi kısa sürede listelemekti, Ekte ki dosyam üzerinde Rapor sayfasındaki Combo dan seçim yaparsanız ne demek istediğimi anlayabilirsiniz.

Sayın sdegirmenci,

Kodları denediniz mi?

Ben kodlarda bir hız sorunu görmedim.

Tekrar yazıyorum. İki kod da da aynı yapı vardır. "Find" yapısı, hızlarında farklılık göremedim. Tek yaptığım hatayı aramak yerine yenisini yazmaktı.

Üstelik sizin dosyada aynı koda, diğerinden fazla olarak bir şart ve renk için for next döngüsü yazılmış. Yani yaptığı işlem daha fazladır. Yanlıştır demiyorum, sadece şart fazla olduğu için extra kod vardır diyorum.

.

 

[sdegirmenci]

Hocam Çok teşekkür ederim, yeni konu açmama hiç gerek yok ,sizi yordum, işleriniz kolay gelsin.

 

[Ömer]

Rica ederim.

Buda sizin kodlar, hatalı satırları kırmızı yapıp pasifleştirdim. yeni ilaveleri mavi ile işaretledim.

Private Sub ComboBox1_Change()
[COLOR=blue]Dim Bul As Range, Satır As Long, adres As Variant, DP As Worksheet[/COLOR]
 
    Set DP = Sheets("DEPO")
    If ComboBox1 <> "" Then
    Application.ScreenUpdating = False
    [C16:P200].ClearContents
    Satır = 16
    Set Bul = DP.[C:C].Find((ComboBox1))
    If Not Bul Is Nothing Then
    adres = Bul.Address
    Do
    'If DP.Cells(Bul.Row, "C") = [E8] Then
 
    Cells(Satır, "C") = Satır - 15             '
 
    [COLOR=red]'Cells(Satır, "C") = DP.Cells(Bul.Row, "G") 'SIRA NO ( burada hata yok fakat ya bir üsteki satırı kullanın yada bu satırı. Diğeri 1 den başlayarak sıra verir bu ise depo sayfasındaki F sütunundan veri alır.[/COLOR]
    Cells(Satır, "D") = DP.Cells(Bul.Row, "F") 'TAHAKKUK TARİHİ
    Cells(Satır, "E") = DP.Cells(Bul.Row, "H") 'MİKTARI
    Cells(Satır, "F") = DP.Cells(Bul.Row, "P") 'FİYAT FARKI
    Cells(Satır, "G") = DP.Cells(Bul.Row, "J") 'TOPLAM
    Cells(Satır, "H") = DP.Cells(Bul.Row, "I") 'KDV
    Cells(Satır, "I") = DP.Cells(Bul.Row, "N") 'GENEL TOPLAM
    Cells(Satır, "J") = DP.Cells(Bul.Row, "L") 'STOPAJ
    Cells(Satır, "K") = DP.Cells(Bul.Row, "M") 'DAMGA VERG.
    Cells(Satır, "L") = DP.Cells(Bul.Row, "Q") 'TEMİNAT.
    Cells(Satır, "M") = DP.Cells(Bul.Row, "R") '%30
 
    Satır = Satır + 1
 
   [COLOR=red]'End If[/COLOR]
    Set Bul = DP.[C:C].FindNext(Bul)
    Loop While Not Bul Is Nothing And Bul.Address <> adres
    [C15].Select
    End If
    [COLOR=blue]End If[/COLOR]
 
    Set Bul = Nothing
    Set DP = Nothing
  [COLOR=red]  'Next i[/COLOR]
 
End Sub

.

 

[sdegirmenci]

Değerli Ömer Hocam,
Sizi çok yordum, şimdi tam istediğim gibi oldu, Bir anda listeyi dökmekte. Tekrar teşekkür ederim. Saygılarımla.