Değiştir,Sil Makrosundaki hata

[etf]

Ekteki dosyada İsim listesinden veri bulunup Değiştir butonu tıklandığında "Adı Soyadı listesinden bir Kişi seçmelisiniz" uyarısı çıkmakta halbuki zaten seçilmiş durumda. Makro işlemeye devam etmekte kaydedildi uyarısına rağmen verilerde bir değişiklik olmamakta.
Aynı şekilde sil makrosu çalıştırıldığında veriyi silmekte fakat bazı artıklar kalmaktadır.
Birde işin içinden çıkamadığım nokta tc kimlik no'sundan benzer kayıt olmaması.
Bunların sebebini bir türlü çözemedim. Defalarca kodlara baktım artık kafam durdu. Nerde hata yaptığımı da bulamadım. Yardımcı olursanız sevinirim....

 

[hamitcan]

"Txtku" isimli bir textbox yok gördüğüm kadarıyla, aşağıdaki kodu değiştirdim şimdi doğru çalışıyor, siz de bir deneyin.

Private Sub cmdDegistir_Click()
Dim bos As Range
cbAd.RowSource = ""
For Each bos In Range("B2:B" & WorksheetFunction.CountA(Range("B2:B65000")))
If cbAd.Value = "" Or bos = "" Or ActiveCell = "" Then
MsgBox "Önce aradığınız veriyi BUL ile bulmalısınız"
Exit Sub
End If
Next bos
If txtsira = "" Or cbAd = "" Or txtkim = "" Or txtdt = "" Then
MsgBox "Adı Soyadı listesinden bir Kişi seçmelisiniz"
Else
ActiveCell = cbAd
ActiveCell.Offset(0, 1) = txtkim
ActiveCell.Offset(0, 2) = txtdt
ActiveCell.Offset(0, 3) = txtsc
ActiveCell.Offset(0, 4) = cbku
ActiveCell.Offset(0, 5) = cbnt
ActiveCell.Offset(0, 6) = cbec
ActiveCell.Offset(0, 7) = cbssk1
ActiveCell.Offset(0, 8) = cbssk2
ActiveCell.Offset(0, 9) = txttah
ActiveCell.Offset(0, 10) = txtpro
ActiveCell.Offset(0, 11) = txtkn
ActiveCell.Offset(0, 12) = txtyk
ActiveCell.Offset(0, 13) = Txtil
ActiveCell.Offset(0, 14) = Txttel
End If
Workbooks("BB.XLS").Save
MsgBox "Veriniz değiştirildi", , "KAYIT"
cmdtemizle_Click
cbAd.RowSource = "Veri!B2:B" & [Veri!a65536] + 1
txtsira.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1
End Sub

 

[etf]

"Txtku" isimli bir textbox yok gördüğüm kadarıyla, aşağıdaki kodu değiştirdim şimdi doğru çalışıyor, siz de bir deneyin.

Teşekküler emeğinize sağlık. txtku isimli textbox cbku combobox olacaktı şimdi gayet iyi çalışıyor. Tekrar tekrar teşekkürler...
Tc kimlik no ya göre benzrsiz kayıt nasıl yapabileceğimi de söylerseniz ellerinizden hürmetle öperim..

 

[Ali]

Tc kimlik no ya göre benzrsiz kayıt nasıl yapabileceğimi de söylerseniz

Veri sayfanıza aşağıdaki kodları ekleyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For c = [c65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("c2:c" & c), Cells(c, "c")) > 1 Then Rows(c).Delete
Next
End Sub

 

[hamitcan]

Koda bir ekleme yaptım, umarım doğru anlamışımdır. Aynı TC kimlik numarasından varsa uyarıyor.

Private Sub cmdkaydet_Click()
Dim bak As Range
Dim say As Integer
For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000")))
If bak.Value = cbAd.Value Then
MsgBox "Bu Kayıt numarası bulundu."
Exit Sub
End If
Next bak
For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
If StrConv(bak.Value, vbUpperCase) = StrConv(cbAd.Value, vbUpperCase) Then
MsgBox "Bu isimde bir kaydınız bulundu"
Exit Sub
End If
Next bak
For Each bak In Range("c1:c" & WorksheetFunction.CountA(Range("c1:c65000")))
If bak.Value = Val(txtkim) Then
MsgBox "Bu T.C.kimlik numarası daha önce girilmiş."
Exit Sub
End If
Next bak

say = WorksheetFunction.CountA(Range("B1:B65000"))
txtsira.Value = say

Cells(say + 1, 1).Value = txtsira.Value
Cells(say + 1, 2).Value = cbAd.Value
Cells(say + 1, 3).Value = txtkim.Value
Cells(say + 1, 4).Value = txtdt.Value
Cells(say + 1, 5).Value = txtsc.Value
Cells(say + 1, 6).Value = cbku.Value
Cells(say + 1, 7).Value = cbnt.Value
Cells(say + 1, 8).Value = cbec.Value
Cells(say + 1, 9).Value = cbssk1.Value
Cells(say + 1, 10).Value = cbssk2.Value
Cells(say + 1, 11).Value = txttah.Value
Cells(say + 1, 12).Value = txtpro.Value
Cells(say + 1, 13).Value = txtkn.Value
Cells(say + 1, 14).Value = txtyk.Value
Cells(say + 1, 15).Value = Txtil.Value
Cells(say + 1, 16).Value = Txttel.Value

Workbooks("BB.XLS").Save
MsgBox "Verileriniz Kaydedildi", , "KAYIT"
cbAd.RowSource = "Veri!B2:B" & say + 1
txtsira.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1
End Sub

 

[etf]

Elleriniz dert görmesin. O kadar rahatladım ki iyi varsınız. Saygı ve hürmetle...