Bul fonksiyonu hakkında

[direnist]

Merhaba arkadaşlar;

Elimde ekteki gibi bir dosyam var. Ben bu dosyaya basit bir userform ekleyip bu Bul butonu ile aradığım semtin hangi ilçe ve ile bağlı olduğunu bana bir mesaj kutusu ile "şu isimli semt şu isimli ilçeye ve şu isimli ile bağlıdır" şeklinde gösteren bir çalışma yapmak istiyorum.
Bir de birden fazla aynı isimde semtler var ise diğerini göster şeklinde bir buton ile diğerlerinide bana bir mesaj kutusu ile gösteren bir özellikte eklemek istiyorum..
Bu istediğim sanki bir sipariş veriyormuş gibi gelebilir.Ama gerçekten uğraştım ve maalesef yapamadım. Konu hakkında siz üstatlardan değerli bilgilerinizi rica ederim.Şimdiden teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Örnek dosya eklermisiniz.

 

[direnist]

Korhan Bey örnek dosyamı ekliyorum.Teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Uygulanan kodlar;

Userformu açmak için kullanılan kodlar;

Option Explicit
 
Sub FORM()
    UserForm1.Show
End Sub

Userform üzerinde arama ve listeleme işlemlerini yapmak için kullanılan kodlar;

Option Explicit
 
Dim BUL As Range, ADRES As String, SATIR As Long
 
Private Sub CommandButton1_Click()
    If TextBox1 <> Empty Then
    Set BUL = [D:D].Find(TextBox1, LookAt:=xlPart)
    If Not BUL Is Nothing Then
    Label2.Caption = Cells(BUL.Row, "D") & " isimli semt " & Cells(BUL.Row, "C") & " isimli ilçeye " & Cells(BUL.Row, "B") & " isimli ile bağlıdır."
    End If
    Set BUL = Nothing
    Else
    Label2.Caption = Empty
    End If
End Sub
 
Private Sub CommandButton2_Click()
    If TextBox1 <> Empty Then
    ListBox1.Clear
    ListBox1.ColumnCount = 3
    SATIR = 0
    Set BUL = [D:D].Find(TextBox1, LookAt:=xlPart)
    If Not BUL Is Nothing Then
    ADRES = BUL.Address
    Do
    ListBox1.AddItem
    ListBox1.List(SATIR, 0) = Cells(BUL.Row, "D")
    ListBox1.List(SATIR, 1) = Cells(BUL.Row, "C")
    ListBox1.List(SATIR, 2) = Cells(BUL.Row, "B")
    SATIR = SATIR + 1
    Set BUL = [D:D].FindNext(BUL)
    Loop While Not BUL Is Nothing And BUL.Address <> ADRES
    End If
    Set BUL = Nothing
    Label6.Caption = "KAYIT SAYISI : " & Format(IIf(ListBox1.ListCount > 0, ListBox1.ListCount - 2, 0), "#,##0")
    Else
    ListBox1.Clear
    End If
End Sub

 

[direnist]

Çok teşekkür ederim Korhan Bey. Sizlerin bu bilgilerinizi ve yaptıklarınızı gıpta ile izliyorum. Acaba ben de bir gün bu seviyeye gelebilecekmiyim çok merak ediyorum. Tekrar teşekkürler.

 

[Necdet]

Merhaba,

Korhan Bey sorunuzu gayet güzel yanıtlamış. Eğer Form kullanmak istemezseniz aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayıp deneyebilirsiniz. Herhangi bir hücreye çift tıklamanız yeterlidir.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Ara, Mesaj As String
Dim c As Variant
Dim FirstAddress As String
Ara = InputBox("Aranacak Semti Yazınız", "Sempt Bulma")
If Ara = "" Then Exit Sub
Mesaj = "ARANAN SEMPT : " & Ara & Chr(10)
With Range("D2:D" & [D65536].End(3).Row)
    Set c = .Find(Ara, LookIn:=xlValues)
    If Not c Is Nothing Then
        FirstAddress = c.Address
        Do
            Mesaj = Mesaj & Chr(10) & Cells(c.Row, "B") & vbTab & ": " & Cells(c.Row, "C")
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> FirstAddress
    End If
End With
MsgBox Mesaj
End Sub

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki dosyada Listbox boş olduğunda kayıt sayısı -2 olarak geliyordu gerekli düzelme yapılıp dosya ve kodlar güncellenmiştir.

 

[inaneker]

sayın ayhan
farklı bir konuda sizden bilgi rica ediyorum. depoya giren bir ürünün son kullanma tarihi excele girilecek ve skt. yaklaşınca bir şekilde beni uyaracak. bu konu hakkında ayrıntılı bilginizi rica ediyorum.