Mükerrer Kayıt varsa uyar git

[konas06]

Selam.
Aşağıdaki gibi bir tablomuz var.
Aynı tarihte aynı sefer numarası ile bilgi girişi yapılırsa uyarı (örneğin: "bu sefer daha önce oluşturulmuştur") verip "o satıra mı gitmek istediğimizi yada bu yeni kayda devam edip etmeyeceğimizi sormasını" nasıl sağlarız. Ancak burada bir husus daha var. sefer numaraları her zaman aynı girilmiyor. 5 yada 6 haneli olup, 4 hanesinin tutması halinde mükerrer gibi algılaması gerekiyor. Ha buna rağmen tekrar yeni sefer oluşturulmak isteniyorsa da ona izin vermesi gerekiyor.

A B C D
PLAKA TARİH SEFER NO BİLETLİ YOLCU
06AFR78 12.02.2010 AFR78 112
06PR779 12.02.2010 PR779 105
06SC986 12.02.2010 SC986 113
06SC987 12.02.2010 SC987 117
06SC989 12.02.2010 SC989 119
06SC985 12.02.2010 SC985 110
06SC990 12.02.2010 SC990 108

Saygılarımla.

 

[konas06]

Mükerrer Kayıt Hakkında

Selam.
Aşağıdaki gibi bir tablomuz var.
Aynı tarihte aynı sefer numarası ile bilgi girişi yapılırsa uyarı (örneğin: "bu sefer daha önce oluşturulmuştur") verip "o satıra mı gitmek istediğimizi yada bu yeni kayda devam edip etmeyeceğimizi sormasını" nasıl sağlarız. Ancak burada bir husus daha var. sefer numaraları her zaman aynı girilmiyor. 5 yada 6 haneli olup, 4 hanesinin tutması halinde mükerrer gibi algılaması gerekiyor. Ha buna rağmen tekrar yeni sefer oluşturulmak isteniyorsa da ona izin vermesi gerekiyor.

A B C D
PLAKA TARİH SEFER NO BİLETLİ YOLCU
06AFR78 12.02.2010 AFR78 112
06PR779 12.02.2010 PR779 105
06SC986 12.02.2010 SC986 113
06SC987 12.02.2010 SC987 117
06SC989 12.02.2010 SC989 119
06SC985 12.02.2010 SC985 110
06SC990 12.02.2010 SC990 108

Saygılarımla.

Bir de ufak bir dosya ekliyorum.
Saygılarımla.

 

[Ömer]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayın. ( 4 hane tutması soldan sağdan ... nasıl olacak daha detaylı açıklayınız. ) Bu kısımı anlamadığım için herhangi bir düzenleme yapmadım. Bu haliyle tam eşleşene bakarak işlem yapıyor.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, onay As String, son As Long
son = [A65536].End(3).Row
If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
    Set c = Range("C1:C" & son - 1).Find(Target, LookIn:=xlValues)
    If Not c Is Nothing Then
        If Cells(c.Row, "B") = Target.Offset(0, -1) Then
            onay = MsgBox("Mükerrer Giriş ~ (Evet)=Devam - (Hayır)=Git", _
            vbCritical + vbYesNo, "Dikkat !")
                If onay = vbNo Then
                    Target.ClearContents
                    Application.Goto c
                End If
        End If
    End If
End Sub

.

 

[konas06]

Teşekkür ederim.