mükerrer kaydı önleme

Merhaba Sayın @YAMAHATO .

Kodda ilgili yere, aşağıda yeşil renklendirdiğim satırları ekleyerek deneyin.


.

Ömer BARAN' Alıntı:

Merhaba Sayın @YAMAHATO .

Kodda ilgili yere, aşağıda yeşil renklendirdiğim satırları ekleyerek deneyin.

Kod:

İndirmek için giriş yapmanız gerekmektedir.
(11 satır)

Genişletmek için tıklayın ...

Ömer Hocamızın müsaadesiyle bir kod'ta ben ekleyeyim.

Private Sub Mukerrer()

Dim conMük As Object: Dim rsMük As Object

MsgBox " Mükerrer çalıştı."

Set conMük = CreateObject("Adodb.Connection")

Set rsMük = CreateObject("adodb.recordset")

conMük.Open "provider=microsoft.jet.oledb.4.0;data source=" & _

ThisWorkbook.FullName & ";extended properties=""Excel 8.0;hdr=yes"""

rsMük.Open "select [SAHİBİNDEN NO] from [SAHİBİNDEN$A1:A]", conMük, 1, 3

Do While Not rsMük.EOF

If rsMük("SAHİBİNDEN NO").Value = Me.TextBox1.Text Then

MsgBox " Bu Parça Kayıtlıdır. ", vbExclamation, "SAT'S"

Var = True

Exit Sub

End If:

rsMük.MoveNext

Loop

If Var = False Then

Call CommandButton1_Click

End If

rsMük.Close: conMük.Close

Set conMük = Nothing: Set rsMük = Nothing

End Sub[/CODE]

MESKO' Alıntı:

Ömer Hocamızın müsaadesiyle bir kod'ta ben ekleyeyim.

Private Sub Mukerrer()

Dim conMük As Object: Dim rsMük As Object

MsgBox " Mükerrer çalıştı."
Set conMük = CreateObject("Adodb.Connection")
Set rsMük = CreateObject("adodb.recordset")

conMük.Open "provider=microsoft.jet.oledb.4.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 8.0;hdr=yes"""

rsMük.Open "select [SAHİBİNDEN NO] from [SAHİBİNDEN$A1:A]", conMük, 1, 3

Do While Not rsMük.EOF
If rsMük("SAHİBİNDEN NO").Value = Me.TextBox1.Text Then
MsgBox " Bu Parça Kayıtlıdır. ", vbExclamation, "SAT'S"
Var = True
Exit Sub
End If:
rsMük.MoveNext
Loop
If Var = False Then

Call CommandButton1_Click

End If
rsMük.Close: conMük.Close
Set conMük = Nothing: Set rsMük = Nothing
End Sub

Genişletmek için tıklayın ...

bu kodu tam olarak nereye ekleyeceğim.

YAMAHATO' Alıntı:

bu kodu tam olarak nereye ekleyeceğim.

Genişletmek için tıklayın ...

UserForm2'ye eklenmesi gerekiyor.