ListBoxt'a Süzme Problemi

[Tasarım]

Arkadaşlar resimde de anlatmaya çalıştığım gibi sorgulama yapmak istediğim de kayıtları Liste kutusunda süzmeyi bir türlü başaramadım. Bununla ilgili örnek dosya ektedir.

 

[Halit TÜRK]

Selam

http://www.excel.web.tr/showthread.php?t=56794&page=2&highlight=listbox+s%FCz

22. mesajdaki kod ile gayet güzel çalışıyor

[FONT="Tahoma"]Private Sub Listele_Click()
kriter = Yeni_Kayit.adi
If kriter = Empty Then Exit Sub
Yeni_Kayit.Liste.RowSource = ""
say = WorksheetFunction.CountIf([B:B], kriter)
For b = 1 To say
adr = "B" & sat + 1 & ":b65536"
sat = WorksheetFunction.Match(kriter, Range(adr), 0) + sat
Yeni_Kayit.Liste.AddItem
For a = 1 To 10
Yeni_Kayit.Liste.List(c, a - 1) = Cells(sat, a)
Next
c = c + 1
Next
    Liste.ColumnHeads = False
    Liste.ColumnCount = 10
    Liste.ColumnWidths = "28;70;120;50;60;60;18;35;35;140"
End Sub[/FONT]

 

[Orion1]

Dosyanız ekte.

Private Sub Listele_Click()
Dim k As Range, ilk_adr As String, a As Long
Liste.RowSource = vbNullString
ReDim myarr(1 To 10, 1 To 1)
Set k = Range("B2:B65536").Find(adi.Value, , xlValues, xlWhole, , 1)
If Not k Is Nothing Then
    ilk_adr = k.Address
    Do
        a = a + 1
        ReDim Preserve myarr(1 To 10, 1 To a)
        For j = 1 To 10
            myarr(j, a) = Cells(k.Row, j).Value
        Next j
        Set k = Range("B2:B65536").FindNext(k)
    Loop While Not k Is Nothing And k.Address <> ilk_adr
    Liste.Column = myarr
    Erase myarr
End If
Set k = Nothing
End Sub

 

[Tasarım]

Selam

http://www.excel.web.tr/showthread.php?t=56794&page=2&highlight=listbox+s%FCz

22. mesajdaki kod ile gayet güzel çalışıyor

[FONT="Tahoma"]Private Sub Listele_Click()
kriter = Yeni_Kayit.adi
If kriter = Empty Then Exit Sub
Yeni_Kayit.Liste.RowSource = ""
say = WorksheetFunction.CountIf([B:B], kriter)
For b = 1 To say
adr = "B" & sat + 1 & ":b65536"
sat = WorksheetFunction.Match(kriter, Range(adr), 0) + sat
Yeni_Kayit.Liste.AddItem
For a = 1 To 10
Yeni_Kayit.Liste.List(c, a - 1) = Cells(sat, a)
Next
c = c + 1
Next
    Liste.ColumnHeads = False
    Liste.ColumnCount = 10
    Liste.ColumnWidths = "28;70;120;50;60;60;18;35;35;140"
End Sub[/FONT]

Oradaki kodla bir müddet çalıştı ancak daha sonra nedenini bilmediğim bir sebeple bir daha çalışmadı.

Teşekkür ederim.

 

[Tasarım]

Dosyanız ekte.

Private Sub Listele_Click()
Dim k As Range, ilk_adr As String, a As Long
Liste.RowSource = vbNullString
ReDim myarr(1 To 10, 1 To 1)
Set k = Range("B2:B65536").Find(adi.Value, , xlValues, xlWhole, , 1)
If Not k Is Nothing Then
    ilk_adr = k.Address
    Do
        a = a + 1
        ReDim Preserve myarr(1 To 10, 1 To a)
        For j = 1 To 10
            myarr(j, a) = Cells(k.Row, j).Value
        Next j
        Set k = Range("B2:B65536").FindNext(k)
    Loop While Not k Is Nothing And k.Address <> ilk_adr
    Liste.Column = myarr
    Erase myarr
End If
Set k = Nothing
End Sub

Çok teşekkür ederim.

 

[Tasarım]

@Evren Gizlen
Katkılarınızdan dolayı çok teşekkür ederim. Sorun çözüldü

 

[Tasarım]

Arkadaşlar yine bir sorunla karşı karşı kaldım ve içerisinden çıkamadım. Sorunum:

"Hasta Yakını Ekleme" bölümünde yakının adını ve soyadını sorgulamak istiyorum. Tek kayıtlarda normal olarak buluyor ve Text kutularına aktırıyor ancak; isim benzerliği bulunan ve soyisimleri farklı olan kişilerde bir türlü sorgulama yapmıyor. Yaklaşık 1,5 gündür değişik kombinasyonlar denedim, forumdan değişik kodlarla uğraştım ama sonuç hala aynı. Örnek dosyayı ekledim.

Yardımı olacak arkadaşlara şimdiden teşekkürler.

 

[Tasarım]

Ayrıca "Seçiniz" yazan Combobox'lara veri aktarımı da yapamıyorum.

 

[Tasarım]

Kimse yardım etmeyecek sanırım

 

[ofbalki]

http://www.excel.web.tr/showthread.php?p=313048#post313048

Yukarıdaki linkte hazırladığım bir sevk programı var, belki işinize yarar.

 

[Tasarım]

http://www.excel.web.tr/showthread.php?p=313048#post313048

Yukarıdaki linkte hazırladığım bir sevk programı var, belki işinize yarar.

Elinize sağlık güzel olmuş ancak; ben kendimi bu konularda geliştimek amacıyla daha farklı uygulamalar yapmak istiyordum.

 

[Halit TÜRK]

.......................

 

[Halit TÜRK]

Ayrıca "Seçiniz" yazan Combobox'lara veri aktarımı da yapamıyorum.

Private Sub Per_Adi_Change()
 i = Per_Adi.ListIndex + 2
    Yakin_Ad = Cells(i, "C")
    Yakin_Tc = Cells(i, "D")
    Yakin_Karne = Cells(i, "E")
    Has_Yakin = Cells(i, "F")
Yakin_Ad.SetFocus
End Sub