DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Select Case Len(Target)
Case 3
Case 1 To 2, 4, 5, 7 To 9
MsgBox "Hatalı Hesap Kodu"
Target.Offset(0, 0).Select
Target = ""
Exit Sub
Case 6, 10
If Len(Target) = 6 Then
BirEksik = Left(Target, 4) & Format(Right(Target, 2) + 0 - 1, "00")
Else
BirEksik = Left(Target, 8) & Format(Right(Target, 3) + 0 - 1, "00")
End If
Var = 0
Var = Sheets(1).[A:A].Find(BirEksik).Row
If Var = 0 Then
MsgBox BirEksik & " Nolu Hesabı Açmadan " & Target & " Hesabı Açmaya Çalışıyon Yav Alla Alla"
Target.Offset(0, 0).Select
Target = ""
Exit Sub
End If
' Var = 0
' Var = Sheets(1).[A:A].Find(Target).Row
' If Var <> Target.Row Then
' MsgBox Target & " Hesabını Daha Önce Kullandınız"
' Target.Offset(0, 0).Select
' Target = ""
' Exit Sub
' End If
Case 10
End Select
Son:
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Değer = Split(Target, " ")
Select Case UBound(Değer)
Case 0
Case 1: Kontrol = Değer(0)
Case 2: Kontrol = Değer(0) & " " & Format(Değer(1), "00")
End Select
Varmi = 0
Varmi = Application.WorksheetFunction.CountIf([A:A], Kontrol)
If Varmi = 0 Then
MsgBox "Bir Üst Hesap " & Kontrol & " Açılmamış..."
Target.Offset(0, 0).Select
Target = ""
Exit Sub
End If
Son:
End Sub