[Çözüldü] Kayıt Bul Kodunda Hata

[mapman]

İşyerinde görevim gereği evde bakım hizmeti alan hastaların ev ziyareti sonuçlarını excelde toparlamak için oluşturduğum userformda kayıt bul butonunda sorun yaşıyorum.Userformda özürlünün adı soyadı yazdığımda kayıt bul butonuna tıklayınca usrformda geri kalan bilgilerin otomatik tamamlanmasını istiyorum. Vba şifresi 142142 dir
Yeni kayıt ekleyince direkt a4 hücresine önceki kayıt yerine ekleniyor.a5 den başlayarak sıralı kayıt yapmıyor.Kodlardaki

Private Sub CommandButton1_Click()
Range("a4").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("a5").Value = "" Then
Range("a4").Value = 1
Range("a4").Select

makrosundaki If Range("a5").Value = "" Then değerini a4 olarak değiştirdiğimde bu sorun çözülüyor.Yani sıra ile alt alta yeni kayıtları ekliyor.Ama bu seferde kayıt bul butonunda a4 den sonraki kayıtları bulmuyor.

Kayıt bul butonunun kodları ise şöyle:
Private Sub CommandButton2_Click() 'bul
For Each hucre In Range("b4:b" & WorksheetFunction.CountA(Range("b4:b65000")))
If StrConv(hucre.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
hucre.Select
TextBox2.Text = Sheets("sayfa1").Range("c" & ComboBox1.ListIndex + 4)
TextBox3.Text = Sheets("sayfa1").Range("d" & ComboBox1.ListIndex + 4)
TextBox4.Text = Sheets("sayfa1").Range("e" & ComboBox1.ListIndex + 4)
TextBox5.Text = Sheets("sayfa1").Range("f" & ComboBox1.ListIndex + 4)
TextBox6.Text = Sheets("sayfa1").Range("g" & ComboBox1.ListIndex + 4)
TextBox7.Text = Sheets("sayfa1").Range("h" & ComboBox1.ListIndex + 4)
TextBox8.Text = Sheets("sayfa1").Range("ı" & ComboBox1.ListIndex + 4)
TextBox9.Text = Sheets("sayfa1").Range("j" & ComboBox1.ListIndex + 4)
TextBox10.Text = Sheets("sayfa1").Range("k" & ComboBox1.ListIndex + 4)
TextBox11.Text = Sheets("sayfa1").Range("l" & ComboBox1.ListIndex + 4)
End If
Next
End Sub

Yardımcı olabilecek arkadaşların yardımını bekliyorum.Vba şifresi 142142 dir

[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

[Bülent Öztürk]

Özgür Bey, kaydetmek için kullandığınız kodu şu şekilde değiştirin;

Kod: [Seç]

Private Sub CommandButton1_Click()
Dim SonDoluSatir As Long
SonDoluSatir = Worksheets("Sayfa1").Range("A65536").End(3).Row + 1
Worksheets("Sayfa1").Range("A" & SonDoluSatir) = SonDoluSatir - 3

 Worksheets("Sayfa1").Range("B" & SonDoluSatir) = ComboBox1.Text
 Worksheets("Sayfa1").Range("C" & SonDoluSatir) = TextBox2.Text
 Worksheets("Sayfa1").Range("D" & SonDoluSatir) = TextBox3.Text
 Worksheets("Sayfa1").Range("E" & SonDoluSatir) = TextBox4.Text
 Worksheets("Sayfa1").Range("F" & SonDoluSatir) = TextBox5.Text
 Worksheets("Sayfa1").Range("G" & SonDoluSatir) = TextBox6.Text
 Worksheets("Sayfa1").Range("H" & SonDoluSatir) = TextBox7.Text
 Worksheets("Sayfa1").Range("I" & SonDoluSatir) = TextBox8.Text
 Worksheets("Sayfa1").Range("J" & SonDoluSatir) = TextBox9.Text
 Worksheets("Sayfa1").Range("K" & SonDoluSatir) = TextBox10.Text
 Worksheets("Sayfa1").Range("L" & SonDoluSatir) = TextBox11.Text

 aciklama = "Kayıt tamamlandı."
 buton = vbOKOnly + vbInformation + vbDefaultButton1
 baslik = "Özürlü Evde Bakım Programı"
MsgBox aciklama, buton, baslik
 'TextBox1.Text = ""
 TextBox2.Text = ""
 TextBox3.Text = ""
 TextBox4.Text = ""
 TextBox5.Text = ""
 TextBox6.Text = ""
 TextBox7.Text = ""
 TextBox8.Text = ""
 TextBox9.Text = ""
 TextBox10.Text = ""
 TextBox11.Text = ""
End Sub

[Bülent Öztürk]

Kayıt bulmak için;

Kod: [Seç]

Private Sub CommandButton2_Click() 'bul
Dim hucre As Range
For Each hucre In Range("b4:b" & Worksheets("Sayfa1").Range("A65536").End(3).Row)
If StrConv(hucre.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
 
   TextBox2.Text = Sheets("Sayfa1").Range("c" & hucre.Row)
   TextBox3.Text = Sheets("Sayfa1").Range("d" & hucre.Row)
   TextBox4.Text = Sheets("Sayfa1").Range("e" & hucre.Row)
   TextBox5.Text = Sheets("Sayfa1").Range("f" & hucre.Row)
   TextBox6.Text = Sheets("Sayfa1").Range("g" & hucre.Row)
   TextBox7.Text = Sheets("Sayfa1").Range("h" & hucre.Row)
   TextBox8.Text = Sheets("Sayfa1").Range("ı" & hucre.Row)
   TextBox9.Text = Sheets("Sayfa1").Range("j" & hucre.Row)
   TextBox10.Text = Sheets("Sayfa1").Range("k" & hucre.Row)
   TextBox11.Text = Sheets("Sayfa1").Range("l" & hucre.Row)
End If
Next
End Sub

[mapman]

Bülent Bey ellerinize sağlık. Şükranlarımı sunuyorum.   Tamamen istediğim gibi oldu ve sorun çözüldü.Teşekkürü bir borç bilirim. İyi günler.

[Bülent Öztürk]

Rica ederim.
Çalışmalarınızda başarılar.