kod hata veriyor...

[karakayalı]

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [E:E]) Is Nothing Then Exit Sub
Satır = "E" & Target.Row & ":a" & Target.Row
Select Case Target
Case "BEKLEMEDE": Range(Satır).Font.ColorIndex = 3


End Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
...................
çift kayıt girişlerini önleyen kodlarım var...

bunlar ayrı ayrı sayfada kusursuz çalışmakta ancak aynı sayfanın kod bölümüne yazdığımda hata vermekte...yardım ederseniz sevinirim. kolay gelsin..

 

[leumruk]

Aynı sayfanın kod bölümü derken ne demek istediniz, biraz daha açabilir misiniz? Bu kod şu haliyle ayrı sayfalara birer tane kaydedilmek zorunda. Siz Thisworkbooka mı kaydetmek istiyorsunuz.

 

[hsayar]

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [E:E]) Is Nothing Then Exit Sub
Satır = "E" & Target.Row & ":a" & Target.Row
Select Case Target
Case "BEKLEMEDE": Range(Satır).Font.ColorIndex = 3


End Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
...................
çift kayıt girişlerini önleyen kodlarım var...

bunlar ayrı ayrı sayfada kusursuz çalışmakta ancak aynı sayfanın kod bölümüne yazdığımda hata vermekte...yardım ederseniz sevinirim. kolay gelsin..

aynı modülde aynı isimde modül olamaz iki modulkü birleştirmek gerekir.
her iki Worksheet_Change prosodürünü buraya yazınız ve örnek dsoay ekleyiniz.

 

[karakayalı]

dosya ektedir...kolay gelsin...

 

[leumruk]

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, [b2:b65536]) Is Nothing Then Exit Sub
    say = WorksheetFunction.CountIf(Range("b1:b" & Target.Row - 1), Target)
    If say > 0 Then
    MsgBox "Numara Mevcuttur...Çift Girişe Onay Verilmez..."
    Target.Select
    Target = ""
    End If

    On Error Resume Next
    If Intersect(Target, [c:c]) Is Nothing Then Exit Sub
    satır = "h" & Target.Row & ":a" & Target.Row
    Select Case Target
    Case "BEKLEMEDE": Range(satır).Font.ColorIndex = 5
    End Select
End Sub

Kodu bu şekilde dener misiniz?

 

[karakayalı]

SAYIN leumruk, ÇİFT KAYIT KODU ÇALIŞTI ANCAK DİĞERİ ÇALIŞMADI

 

[hsayar]

[e4:e65536,g4:g65536,ı4:j65536,m4:m65536])

örnek dosya olmadığı için emin değilm ama deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
'    If Intersect(Target, [b2:b65536]) Is Nothing Then Exit Sub
    If Intersect(Target, [b2:b65536[B][COLOR=Red], c:c[/COLOR][/B]]) Is Nothing Then Exit Sub

[COLOR=Red]with target[/COLOR]
  [COLOR=Red] if .Column = 2 then[/COLOR]
     say = WorksheetFunction.CountIf(Range("b1:b" & .Row - 1), Target)
    If say > 0 Then
    MsgBox "Numara Mevcuttur...Çift Girişe Onay Verilmez..."
    .Select
    .value = empty
    End If

[COLOR=Red]  elseif .Column = 3 then[/COLOR]
'    If Intersect(Target, [c:c]) Is Nothing Then Exit Sub
    satır = "h" & .Row & ":a" & .Row
    Select Case Target
    Case "BEKLEMEDE": Range(satır).Font.ColorIndex = 5
    End Select
 [COLOR=Red] end if[/COLOR]
[COLOR=Red]end with[/COLOR]
End Sub

 

[Orion1]

Gerçi sayın Hsayar cevabı vermiş ama bende dosyayı yolluyorum.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [b2:b65536,c:c]) Is Nothing Then Exit Sub
'===================================================
If Target.Column = 2 Then
    say = WorksheetFunction.CountIf(Range("b1:b" & Target.Row - 1), Target)
    If say > 0 Then
    MsgBox "Numara Mevcuttur...Çift Girişe Onay Verilmez..."
    Target.Select
    Target = ""
    End If
    Else
'====================================================
satır = "h" & Target.Row & ":a" & Target.Row
Select Case Target
Case "BEKLEMEDE": Range(satır).Font.ColorIndex = 5
End Select
End If
End Sub

 

[karakayalı]

ellerinize sağlık, çok güzel olmuş...teşekkürler...