Sutuna Kayıt

[seddur]

Merhabalar.Aşağıdaki kod ile Kayıt sayfasında X.satırın C sutunundan başlayarak sırasıyla D-E-F-G-H-I-J-K-L-M-N-0 sutunlarına kayıt yapacak kod yazmaya çalıştım ama olmadı.Yardımcı olursanız sevinirim.

Private Sub CommandButton19_Click()
Dim s1 As Worksheet
Dim x,sonsut As Integer
Set s1 = Sheets("Kayıt")
For x = 1 To s1.Cells(Rows.Count, "a").End(xlUp).Row
For sonsut = 3 To s1.Cells(3, Columns.Count).End(xlToLeft).Column + 1
If s1.Cells(x, "a") = TextBox19.Text And CDate(s1.Cells(x, "b")) = CDate(TextBox2) Then
s1.Cells(x, sonsut) = TextBox3
End If
Next: Next

End Sub

 

[ÖmerFaruk]

Tam olarak yapmaya çalıştığınızı şöyle anladım.

A=TextBox19 ve B=Cdate(TextBox2) ise
ilgili satırın C:O aralığına TextBox3 değerini yaz.

Bu işlemi tüm satırlar için kontrol ederek tekrarla.

İstek eğer buysa kodlarınızı azıcık değiştirdim

Private Sub CommandButton19_Click()
    Dim s1 As Worksheet
    ' her bir değişkeni tanımlamazsanız tanımlanmayan değişken Variant kabul edilir, hafızada yer kaplar
    Dim x As Integer, sonsut As Integer
    Set s1 = Sheets("Kayıt")
    x = s1.Cells(Rows.Count, "a").End(xlUp).Row
    For x = 1 To s1.Cells(Rows.Count, "a").End(xlUp).Row
        'Sorguyu satırda yapıp doğruysa sütunlara yazdırdım
        If s1.Cells(x, "a") = TextBox19.Text And CDate(s1.Cells(x, "b")) = CDate(TextBox2) Then
            For sonsut = 3 To s1.Cells(3, Columns.Count).End(xlToLeft).Column + 1
                s1.Cells(x, sonsut) = TextBox3
            Next
        End If
    Next
End Sub

 

[seddur]

Doğru anlamışsınız.Kodu denedim,verileri sürekli olarak x.satırın "C" sutununa kaydediyor yandaki sutuna geçmiyor.

 

[seddur]

Ekli dosyada textbox1 ve Textbox2'deki isimleri x. satırın (Tarih yazılı satır) "C" ve "D" sutunlarına sırayla yazdırmak istiyorum.Kod Kaydet butonunda yazılı ancak çalışmıyor.Acaba yardımcı olacak bir arkadaş var mı?

 

[ÖmerFaruk]

Örnek dosyanız sorunuza göre eksiklere sahip.
Aşağıdaki kod satırının hitap ettiği 3. satırda herhangi bir veriniz yok.
For sonsut = 3 To s1.Cells(3, Columns.Count).End(xlToLeft).Column + 1

 

[seddur]

Sayfa örneğini yaptım.Textbox2 yi kaydediyor textbox1 i kaydetmiyor.

 

[Korhan Ayhan]

Deneyiniz.

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, Bul As Range
    
    Set S1 = Sheets("Sayfa1")
    
    Set Bul = S1.Range("A:A").Find(TextBox3.Text, , , xlWhole)
    If Not Bul Is Nothing Then
        If Bul.Offset(, 1) = CommandButton2.Caption Then
            S1.Cells(Bul.Row, Columns.Count).End(1)(1, 2) = TextBox1.Text
            S1.Cells(Bul.Row, Columns.Count).End(1)(1, 2) = TextBox2.Text
        End If
    End If
    
    Set Bul = Nothing
    Set S1 = Nothing
End Sub