Değere göre satır boşluğu

[attrd]

Arkadaşlar öncelikle kolay gelsin
K3 ,L3,M3 satırından başlamak üzere K70,L70,M70 KADAR
KLM satırının birine yazılan bir metin örnegin ''ali''ismi KLM 13 E kadar yazılabilsin fakat KLM 14 veya daha sonrasından den birine yazmaya kalkınca mesaj kutusu ile uyarı vererek belirlenen bosluk satırını gununu astıgımızı belirtsın devam etmek istediğimizi evet hayır olarak sorsun evet dediğimizde aynı ''ali'' ismini klm14 den birine yazabileleim hayır dedığımızde hücre ye yazdırmasın. örnegin KLM 3 KLM 5 e ''ALİ '' yazdığımızda KLM 3 den degilde enson yazılan KLM 5 dekı metni baz alarak 13 KLM satırına yazdırsın 14. satıra gelince tekrar uyarı versin enson yazılan satır baz alınarak işlem yapsın . Yanı kisilerin yazıldığı aralık 13 ü geçmesin. enson '' ALİ '' ismi KLM 35 den birine yazılmışsa KLM 35 den itibaran 13 güne yazdırsın 14 ce diger hücrelere yazdırmasın .Anlatacagım aynı hücre degerleri mesela ''ali'' değeri, araları 13 sutundan fazla olmasın .böyle bir makro yapmaya calıstım İf ELSE ile yapamadım.Yardımcı olursanız sevinirim.
saygılarımla ALLAH a emanet olunuz.

 

[YUSUF44]

Anladığım kadarıyla aşağıdaki kodları hazırladım, inceleyiniz. Kodlar bir sütuna o veri ilk kez giriliyorsa bir şey yapmaz, eğer o sütüna daha önce girilmiş bir veriyse ve kendinden önceki 13 hücrede o veri yoksa uyarı verir:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K3:M70")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If WorksheetFunction.CountIf(Range(Cells(WorksheetFunction.Max(3, Target.Row - 13), Target.Column), _
Cells(Target.Row, Target.Column)), Target) = 1 Then
    If WorksheetFunction.CountIf(Range(Cells(Target.Row - 1, Target.Column), Cells(1, Target.Column)), Target) = 0 Then
    GoTo 10
    Else
        MsgBox "Aralık 13'ten fazla", vbCritical
        Target.ClearContents
        Target.Select
    End If
10:
End If
Application.EnableEvents = True
End Sub

 

[attrd]

hocam

Anladığım kadarıyla aşağıdaki kodları hazırladım, inceleyiniz. Kodlar bir sütuna o veri ilk kez giriliyorsa bir şey yapmaz, eğer o sütüna daha önce girilmiş bir veriyse ve kendinden önceki 13 hücrede o veri yoksa uyarı verir:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K3:M70")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If WorksheetFunction.CountIf(Range(Cells(WorksheetFunction.Max(3, Target.Row - 13), Target.Column), _
Cells(Target.Row, Target.Column)), Target) = 1 Then
    If WorksheetFunction.CountIf(Range(Cells(Target.Row - 1, Target.Column), Cells(1, Target.Column)), Target) = 0 Then
    GoTo 10
    Else
        MsgBox "Aralık 13'ten fazla", vbCritical
        Target.ClearContents
        Target.Select
    End If
10:
End If
Application.EnableEvents = True
End Sub

HOCAM eline sağlık tam istediğim gibi yanlız ilk veri K3 yazılıise aynı veri K14 yazılınca uyarı veriyor ilk veri k3 de olup 2. veri k degilde L veya M de olunca da verebilirmi yanı KLM 3 ün nin her hangi birinde hem ilk veri 2. veri de KLM nin herhangi birinde olunca uyarı verebilirmi . Saygılarımla.

 

[attrd]

HOCAM eline sağlık tam istediğim gibi yanlız ilk veri K3 yazılıise aynı veri K14 yazılınca uyarı veriyor ilk veri k3 de olup 2. veri k degilde L veya M de olunca da verebilirmi yanı KLM 3 ün nin her hangi birinde hem ilk veri 2. veri de KLM nin herhangi birinde olunca uyarı verebilirmi . Saygılarımla.

KISACASI K3 e yazdığım degeri m14 de yazınca k3 dekini görmüyor ,k3 yazdığım deger sadece k 14 de görüyor.

 

[YUSUF44]

Aşağıdaki şekilde deneyin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K3:M70")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If WorksheetFunction.CountIf(Range(Cells(WorksheetFunction.Max(3, Target.Row - 13), "K"), _
Cells(Target.Row, "M")), Target) = 1 Then
    If WorksheetFunction.CountIf(Range(Cells(Target.Row - 1, "K"), Cells(1, "M")), Target) = 0 Then
    GoTo 10
    Else
        MsgBox "Aralık 13'ten fazla", vbCritical
        Target.ClearContents
        Target.Select
    End If
10:
End If
Application.EnableEvents = True
End Sub

 

[attrd]

COK cOK TEŞEKKÜR EDİYORUM.ALLAH razı olsun.