mükerrer kayıt yapmasın.başka bir no ile diye sorsun.

Katılım
29 Haziran 2007
Mesajlar
201
Excel Vers. ve Dili
ofis20007
slm.arkadaşlar aşağıdaki 1 .kod mükerrer kayıt için 2. kod ise normal kayıt için.ben kayıt sayfasındaki "B" stununa göre mükerrer kayıta izin vermemesini istiyorum."TextBox1 B stununa kayıt yapıyor".kodda gerekli revizyonu yapabilirseniz sevinirim.

Private Sub CommandButton3_Click()
‘MÜKERRER KAYITA İZİN VERMEYECEK
If TextBox1.Value <> "" Then
Sheets("KAYIT").Activate
Cells(1, 2).Select
Do While ActiveCell.Value <> ""
If Trim(ActiveCell.Value) = Trim(Me.TextBox1.Value) Then
If MsgBox(Me.TextBox1 & " NOLU PERSONEL KAYITLI" & " BA&#350;KA B&#304;R NO &#304;LE KAYIT YAPILSIN MI?", vbYesNo) = vbNo Then Exit Sub
End If
ActiveCell.Offset(1, 2).Activate
Loop
ActiveCell.Value = TextBox1.Value
ActiveCell.Offset(1, 2).Value = TextBox1.Value
End If

'KAYIT BUTONU
On Error Resume Next
Son = Sheets("KAYIT").[a65536].End(3).Row
Sheets("KAYIT").Cells(Son + 1, 2) = TextBox1.Value
Sheets("KAYIT").Cells(Son + 1, 3) = TextBox2.Value
Sheets("KAYIT").Cells(Son + 1, 4) = TextBox3.Value
Sheets("KAYIT").Cells(Son + 1, 5) = TextBox4.Value
Sheets("KAYIT").Cells(Son + 1, 6) = TextBox5.Value
Sheets("KAYIT").Cells(Son + 1, 1) = TextBox6.Value
Sheets("KAYIT").Cells(Son + 1, 7) = TextBox7.Value
Sheets("KAYIT").Cells(Son + 1, 8) = TextBox8.Value
Sheets("KAYIT").Cells(Son + 1, 9) = TextBox9.Value
Sheets("KAYIT").Cells(Son + 1, 10) = TextBox10.Value
Sheets("KAYIT").Cells(Son + 1, 271) = OptionButton2.Value
UserForm_Initialize
MsgBox "Bilgi Eklendi !...", vbOKOnly + vbInformation, "Bilgi Ekleme"
' CommandButton3_Click
End Sub
 
Katılım
10 Nisan 2008
Mesajlar
578
Excel Vers. ve Dili
2000,2003,2007
Merhaba,
Umar&#305;m i&#351;inize yarar.Kodu aktif sayfan&#305;z&#305;n kod b&#246;l&#252;m&#252;ne yap&#305;&#351;t&#305;r&#305;p denermisiniz.Bu kod b stununa ikinci ayn&#305; veri giri&#351;ine izin vermez.
Syg,
E.ALAN

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