kod kısmında düzenleme

[power]

İyi çalışmalar,
mükerrer sayıyı tespit etme ile ilgili kod var dosyada.yapılması gerekeni dosyaya ekledim.
İlgilenenlere şimdiden teşekkürler.

 

[Muzaffer Ali]

Merhaba.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G:G]) Is Nothing Then Exit Sub
If Target = "" Or UCase(Target) = "ANISIZ" Or UCase(Target) = "DEPO" Or UCase(Target) = "KULLANMIYOR" Or UCase(Target) = "SERİ YÜKLÜ" Or UCase(Target) = "YÜKLENMİYOR" Then Exit Sub
If Len(Target) <> 5 Then
Application.EnableEvents = False
MsgBox " 5 BİT GİRİŞ YAPMALISINIZ!", vbCritical
Target = ""
Target.Select
Application.EnableEvents = True
ElseIf WorksheetFunction.CountIf(Range("G:G"), Target) > 1 Then
Application.EnableEvents = False
MsgBox Target & " BU KOD BAŞKA CİHAZDA YÜKLÜ!", vbCritical
Target = ""
Target.Select
Application.EnableEvents = True
ElseIf IsNumeric(Target) = False Then
Application.EnableEvents = False
MsgBox " SAYISAL GİRİŞ YAPINIZ!", vbCritical
Target = ""
Target.Select
Application.EnableEvents = True
End If
End Sub

Kırmızı renkli olan satır siliyor. Bu satırı kodlardan silerseniz sorun hallolur.

 

[power]

Teşekkürler hocam,
belirttiğiniz satırı iptal ettim ilgili hücreyi silmiyor.Fakat şöyle bir ayrıntı çıktı ortaya.G4 hücresindeki "11017" düzeltip "11015" yapıca, eğer bu kod varsa uyarı verdikten sonra G4 hücresi eski haline dönsün yani G4 hücresinde "11017" kod tekrar yazsın. olabilirmi acaba?
özetle,uyarı verirse ilgili hücredeki sayı eski halinde kalsın.uyarı vermesse yeni haliyle kalsın.

 

[Muzaffer Ali]

Bütün kodları silin aşağıdakileri ekleyin.

Dim OncekiDeger As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [G:G]) Is Nothing Then Exit Sub
    If Target = "" Or UCase(Target) = "ANISIZ" Or UCase(Target) = "DEPO" Or UCase(Target) = "KULLANMIYOR" Or UCase(Target) = "SERİ YÜKLÜ" Or UCase(Target) = "YÜKLENMİYOR" Then Exit Sub
    If Len(Target) <> 5 Then
        Application.EnableEvents = False
        MsgBox " 5 BİT GİRİŞ YAPMALISINIZ!", vbCritical
        Target = ""
        Target.Select
        Application.EnableEvents = True
    ElseIf WorksheetFunction.CountIf(Range("G:G"), Target) > 1 Then
        Application.EnableEvents = False
        MsgBox Target & " BU KOD BAŞKA CİHAZDA YÜKLÜ!", vbCritical
        Target = OncekiDeger
        Target.Select
        Application.EnableEvents = True
    ElseIf IsNumeric(Target) = False Then
         Application.EnableEvents = False
         MsgBox " SAYISAL GİRİŞ YAPINIZ!", vbCritical
         Target = ""
         Target.Select
         Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    OncekiDeger = Target.Value
End Sub

 

[power]

hocam kodu uyguladım istediğim gibi çalışıyor fakat zaman zaman "bu kod başka cihazda var" uyarısı verdiği zaman eski koduda siliyor.bu silme işlemi bazen ikinci denememde bazen onbeşinci denememde oluyor.belirli bir peryodu yok gibi.bunun nedeni ne olabilir? Örnek dosyada "11017" "11015" yaptım uyarı penceresi açıldı tamam dediğimde "11017" silindi.

 

[Muzaffer Ali]

Target = "" olan satırları Target = OncekiDeger yapın

 

[power]

Hocam belirttiğiniz düzeltmeyi yaptım fakat sonuç aynı.

 

[Korhan Ayhan]

Aşağıdaki gibi deneyiniz.

Dim Eski_Veri As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo 10
    If Intersect(Target, [G:G]) Is Nothing Then Exit Sub
    Select Case UCase(Target)
        Case Empty, "ANISIZ", "DEPO", "KULLANMIYOR", "SERİ YÜKLÜ", "YÜKLENMİYOR"
            Exit Sub
        Case Else
            Application.EnableEvents = False
            If Len(Target) <> 5 Then
                MsgBox "5 karakter uzunluğunda veri girişi yapmalısınız!", vbCritical
                Target = Eski_Veri
                Target.Select
            ElseIf WorksheetFunction.CountIf(Range("G:G"), Target) > 1 Then
                MsgBox Target & " Bu kod başka cihazda yüklü!", vbCritical
                Target = Eski_Veri
                Target.Select
            ElseIf IsNumeric(Target) = False Then
                 MsgBox "Sayısal giriş yapınız!", vbCritical
                 Target = Eski_Veri
                 Target.Select
            End If
    End Select
    If Eski_Veri = Empty Then Eski_Veri = Target
10  Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Eski_Veri = Target
End Sub

 

[power]

Korhan hocam,
Verdiğiniz kodu uyguladım fakat sonuç aynı.ben bir yerlerde yanlışlıkmı yapıyorum acaba?

 

[Korhan Ayhan]

Uyguladığınız dosyayı ekleyin ve yaşadığınız sıkıntıyı açıklayın. Çözüm bulmaya çalışalım.

 

[power]

Hocam örnek dosyayı tekrar yükledim ve sorumuda dosyaya yazdım.Teşekkürler.

 

[power]

Güncel..

 

[Muzaffer Ali]

Merhaba.
Dosyanız ekte.

 

[power]

problemsiz çalışıyor,çok teşekkür ederim hocam.