Kod Hatası Nerede

[seddur]

Aşağıdaki kod ile Textboxdan excel sayfasına kayıt yapmaya çalışıyorum ama kodlar düzgün yada düzenli çalışmıyor.Nedenini bulamadım."A" sütunundaki değerler comboboxdaki değere eşit olduğunda kayıt yaparak "B" sütununa daha önceden verilmiş sıra numarasını işleyecek aksi durumda yani değer ilk defa giriliyorsa yine kaydı yapacak ama bu sefer YENİ bir sıra numarası girecek.Kodun yazılış amacı bu.İlgilenecek arkadaşa Teşekkür ederim.



Dim mutlu As Long
On Error Resume Next
isim = ComboBox4.Value
mutlu = Sheets("Anasayfa").Range("A10000").End(3).Row + 1
If Sheets("Anasayfa").Cells(mutlu, "A") = ComboBox4.Text Then GoTo atla
Sheets("Anasayfa").Cells(mutlu, "A") = TextBox3.Value
Sheets("Anasayfa").Cells(mutlu, "B") = "=Row()"
Sheets("Anasayfa").Cells(mutlu, "C") = TextBox4.Value
Sheets("Anasayfa").Cells(mutlu, "D") = TextBox5.Value
MsgBox "YENİ KAYIT YAPILMIŞTIR"
Exit Sub
atla:
TextBox3.Value = Sheets("Anasayfa").Cells(mutlu, "A")
Application.WorksheetFunction.VLookup(isim, Sheets("Anasayfa").Range("A15:N50000"), 2, 0) = Sheets("Anasayfa").Cells(mutlu, "B")
TextBox2.Value = Sheets("Anasayfa").Cells(mutlu, "C")
TextBox4.Value = Sheets("Anasayfa").Cells(mutlu, "D")
MsgBox "BENZER KAYIT YAPILMIŞTIR"
Exit Sub

 

[muygun]

Merhaba;
Örneksiz tam anlaşılamıyor ama;
Benzer veri varsa aynı kaydın üzerine, yoksa en son boş satıra kayıt için ekteki kodları inceleyin.
İyi çalışmalar.

 

[Asri]

Alternatif;

Private Sub CommandButton1_Click()
 sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
 satir = varmi(ComboBox4.Text)
 If satir > 1 Then
    Cells(satir, "B").Value = TextBox3
    Cells(satir, "C").Value = TextBox4
    Cells(satir, "D").Value = TextBox5
 Else
    Cells(sonsatir, "A").Value = sonsatir - 1
    Cells(sonsatir, "B").Value = TextBox3
    Cells(sonsatir, "C").Value = TextBox4
    Cells(sonsatir, "D").Value = TextBox5
 End If 
End Sub


Function varmi(bilgi) As Long
    Set sayfak = Range("A:A").Find(bilgi, , xlValues, xlWhole)
    If Not sayfak Is Nothing Then
       varmi = sayfak.Row
       Exit Function
    End If
    varmi = 0
End Function

 

[Asri]

@muygun 'un kodlarını incelediğimde iki defa atama kullanmama gerek olmadığını farkettim.
Daha sade kodları deneyiniz.

Private Sub CommandButton1_Click()
 sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
 satir = varmi(ComboBox4.Text)
 If satir = 0 Then
     satir = sonsatir
     Cells(sonsatir, "A").Value = sonsatir - 1
 End If
    
 Cells(satir, "B").Value = TextBox3
 Cells(satir, "C").Value = TextBox4
 Cells(satir, "D").Value = TextBox5
End Sub

Function varmi(bilgi) As Long
    Set sayfak = Range("A:A").Find(bilgi, , xlValues, xlWhole)
    If Not sayfak Is Nothing Then
       varmi = sayfak.Row
       Exit Function
    End If
    varmi = 0
End Function

 

[seddur]

Arkadaşlar kodlar için teşekkür ederim ama her iki durumda da kayıt yapacak yani üzerine yazmayacak her iki durumda da yeni bir satıra kayıt yapacak

 

[seddur]

@muygun 'un kodlarını incelediğimde iki defa atama kullanmama gerek olmadığını farkettim.
Daha sade kodları deneyiniz.

Private Sub CommandButton1_Click()
sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
satir = varmi(ComboBox4.Text)
If satir = 0 Then
     satir = sonsatir
     Cells(sonsatir, "A").Value = sonsatir - 1
End If
   
Cells(satir, "B").Value = TextBox3
Cells(satir, "C").Value = TextBox4
Cells(satir, "D").Value = TextBox5
End Sub

Function varmi(bilgi) As Long
    Set sayfak = Range("A:A").Find(bilgi, , xlValues, xlWhole)
    If Not sayfak Is Nothing Then
       varmi = sayfak.Row
       Exit Function
    End If
    varmi = 0
End Function

kodlar için teşekkür ederim ama her iki durumda da kayıt yapacak yani üzerine yazmayacak her iki durumda da yeni bir satıra kayıt yapacak

 

[Asri]

kodlar için teşekkür ederim ama her iki durumda da kayıt yapacak yani üzerine yazmayacak her iki durumda da yeni bir satıra kayıt yapacak

Kayıt mevcut mu diye tespit edilmeyecek ise bu durumda her kaydı sonsatir + 1 yaptırın.
benim kodlarımda buradaki satırı
satir = varmi(ComboBox4.Text)

satir=0 olarak değiştirin

Yada anlaşılmayan bir konu var

 

[seddur]

Kayıt mevcut mu diye tespit edilmeyecek ise bu durumda her kaydı sonsatir + 1 yaptırın.
benim kodlarımda buradaki satırı
satir = varmi(ComboBox4.Text)

satir=0 olarak değiştirin

Yada anlaşılmayan bir konu var

Kayıt mevcutmu diye tesbit edilecek. eğer kayıt mevcutsa önceki kaydın sıra numarasını(B sütunu),mevcut değilse yeni bir sıra numarasını("B" sütunu) verecek.Yani her iki durumda da yeni kayıt yapılıyor.

 

[seddur]

Merhaba;
Örneksiz tam anlaşılamıyor ama;
Benzer veri varsa aynı kaydın üzerine, yoksa en son boş satıra kayıt için ekteki kodları inceleyin.
İyi çalışmalar.

Merhaba;
Örneksiz tam anlaşılamıyor ama;
Benzer veri varsa aynı kaydın üzerine, yoksa en son boş satıra kayıt için ekteki kodları inceleyin.
İyi çalışmalar.

Merhaba;
Örneksiz tam anlaşılamıyor ama;
Benzer veri varsa aynı kaydın üzerine, yoksa en son boş satıra kayıt için ekteki kodları inceleyin.
İyi çalışmalar.

Benzer değer varsa da yeni satıra kayıt yapacak.Ama bu kez önceki kaydın sıra numarasını alacak diğer alanlar textboxlara girilen yeni değerlere göre yeniden şekillenecek.

 

[Asri]

Örnek dosya olmayınca kendimize göre birşeyler yapıyoruz

Aynı ID yi veren kodlar, deneyiniz.

Private Sub CommandButton1_Click()
 sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
 satir = varmi(ComboBox4.Text)
 If satir = 0 Then
     satir = sonsatir
     Cells(sonsatir, "B").Value = sonsatir - 1
 Else
     Cells(sonsatir, "B").Value = Cells(satir, "B").Value
     satir = sonsatir
 End If
    
 Cells(satir, "A").Value = TextBox3
 Cells(satir, "C").Value = TextBox4
 Cells(satir, "D").Value = TextBox5
End Sub

Function varmi(bilgi) As Long
    Set sayfak = Range("B:B").Find(bilgi, , xlValues, xlWhole)
    If Not sayfak Is Nothing Then
       varmi = sayfak.Row
       Exit Function
    End If
    varmi = 0
End Function