İçerir gibi ListBox kodlarında değişiklik

[huseyinvurkan]

Sayın Üstadlar. Uzun aramalar sonucu bulabildiğim bir kodu kendi dosyama uyarlamama yardım eder misiniz lütfen. Şöyle ki:

Ömer Baran Beyi'in bir çalışmasında;

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Cells(1, 1) = ListBox1.Column(0)
TextBox1.Visible = False: TextBox1 = ""
ListBox1.Visible = False: ListBox1.Clear: [A2].Activate
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
If ActiveCell.Address(0, 0) = "A1" Then
TextBox1.Visible = True: TextBox1.Activate: Cells(1, 1) = ""
Else
TextBox1.Visible = False: ListBox1.Visible = False
End If
End Sub
Private Sub TextBox1_Change()
With TextBox1
.Top = [A1].Top: .Left = [A1].Left: .Width = [A1].Width: .Height = [A1].Height
End With
If TextBox1 = "" Then
ListBox1.Clear: ListBox1.Height = 0: Exit Sub
End If
ListBox1.Visible = True: ListBox1.Clear: ListBox1.Height = 0
For brn = 1 To 12
If Cells(brn, "e") Like "*" & TextBox1 & "*" Then
ListBox1.AddItem Cells(brn, "E")
End If
ListBox1.Height = 13 * (ListBox1.ListCount) + 8: ListBox1.Width = [A1].Width
Next
End Sub

Kodunu buldum. Bu kod A1 hücresine harf yazıldıkça E1:E12 aralığındaki kelimeleri listeliyor ve çift tıklamayla seçimini sağlıyor.

Ancak benim dosyamda;

1 - Gelir sayfasında öğrenci isimleri C sütununda olacağı için tek bir hücrede değil C sütununun tamamında geçerli olmalı,

2- Listelenecek veriler E1:E12 aralığından değil, okul sayfasında D2 1500 aralığından olmalı,

3- Bu kodlarda A1 hücresine tıklandıkça önceki veriler siliniyor. Benim dosyamda kalıcı olmalı, Seçim için ise tek tık yeterli olur.

http://s6.dosya.tc/server8/d6l0i9/GELiR_GiDER_DEFTERi_V1.xls.html

Yardımlarınıza şimdiden teşekkür ederim.

 

[Ömer BARAN]

Merhaba.

Ekteki belgeyi deneyin.
Belgeye buradan da erişebilirsiniz.
.

 

[huseyinvurkan]

Sayın Baran Yardımınız için teşekkürler. Ancak ufak bir sorun var. Şöyle ki: C sütununda bir isim yazıldıktan sonra aynı hücreye tıklayınca yazılar siliniyor. Oysa kalıcı olmalı. Bu sorunu nasıl gideririz acaba. Teşekkürler.

 

[Ömer BARAN]

Kod'da kırmızı renklendirdiğim kısmı silince istediğinizin olması lazım.
.

[B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/B]
If Selection.Count > 1 Or ActiveCell.Row < 5 Then Exit Sub
If ActiveCell.Column = 3 Then
    TextBox1.Visible = True: TextBox1.Activate[COLOR="Red"][B]: Cells(ActiveCell.Row, 3) = ""[/B][/COLOR]

 

[huseyinvurkan]

Evet şimdi tam istediğim gibi olmuş. Elinize sağlık çok teşekkürler.

 

[Ömer BARAN]

Evet şimdi tam istediğim gibi olmuş. Elinize sağlık çok teşekkürler.

Kolay gelsin.
.