• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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
 
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
 
Geri
Üst