mevcut kodu sütuna göre uyarlamak

[kaleci]

Sayin Arkadaslar
Asagidaki Kod'u bana sayin leventm Hocam vermisti, bana cok faidesi oldu. Ben kendim Kod yazamadigim icin, degisiklikte biraz zorlandim.
Ayni kodu sütunlar icin de kullanmak istiyorum. Bu kod'u sayin leventm hocam satirlar icin vermisti.

Benim bes tane kisaltma harflerim var. Bunlari sahifede (B7:FZ33) arasi üc defa alt alta yazip ve dördüncüyü yazdigimda beni uyarmasi gerekiyor.
Bu Formülü bir türlü sütunlar icin uygulayamadim. Satirlarda cok güzel calisiyor. Cünkü bir Hocamiz ayarlamisti, ben VBA ya yeni basladigim icin cok zor oluyor.

Örnek alt alta u, au, su, k) yazarsam beni Kod' daki gibi "FAZLA SAYIDA KİŞİYE İZİN VERİLDİ" uyarmasi lazim.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c:r]) Is Nothing Then Exit Sub
sat = Target.Row
adr = "c" & sat & ":r" & sat
say = WorksheetFunction.CountA(Range(adr))
If say > 3 Then
MsgBox "FAZLA SAYIDA KİŞİYE İZİN VERİLDİ"
Range(adr).Select
End If
End Sub

Simdiden yardimlariniza tesekkür ederim.
kaleci

 

[Levent Menteşoğlu]

Kodu çalıştığı sayfayı içeren bir dosya eklermisiniz.

 

[kaleci]

Hocam hemen basit bir sey hazirladim ve gönderiyorum

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:40cbdab419]Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c:r]) Is Nothing Then Exit Sub
sat = Target.Row
sut = Left(Target.Address(False, False), 1)
adr = "c" & sat & ":r" & sat
adr2 = sut & "3:" & sut & [a65536].End(3).Row
say = WorksheetFunction.CountA(Range(adr))
say2 = WorksheetFunction.CountA(Range(adr2))
If say > 3 Then
MsgBox "FAZLA SAYIDA KISIYE IZIN VERILDI"
Range(adr).Select
End If
If say2 > 3 Then
MsgBox "FAZLA SAYIDA KISIYE IZIN VERILDI"
Range(adr2).Select
End If
End Sub
[/vb:1:40cbdab419]

 

[kaleci]

Hocam uyguladim, denemek icin hazirladigim Test Dosyasinda calisiyor, ama Test2 isimli Dosya benim ana dosyam, ana Dosyaya uyguladigim zaman calismiyor. Sizce hatayi nerede yapiyorum.

Size Dosyanin ikisinide gönderiyorum. Test2 Dosyasi büyük ama sonra silerseniz Linkte fazla yer kaplamaz.

kaleci

 

[Levent Menteşoğlu]

Dosyanızda kodu eklediğiniz yere aşağıdaki kodu kopyalayın.
[vb:1:0815010605]If Intersect(Target, [b:fz]) Is Nothing Then Exit Sub
sat = Target.Row
sut = Left(Target.Address(False, False), 1)
adr = "b" & sat & ":fz" & sat
say = WorksheetFunction.CountA(Range(adr))
say2 = WorksheetFunction.CountA(Range(Cells(7, Target.Column), Cells([a65536].End(3).Row, Target.Column)))
If say > 3 Then
MsgBox "FAZLA SAYIDA KISIYE IZIN VERILDI"
Range(adr).Select
End If
If say2 > 3 Then
MsgBox "FAZLA SAYIDA KISIYE IZIN VERILDI"
Range(Cells(7, Target.Column), Cells([a65536].End(3).Row, Target.Column)).Select
End If[/vb:1:0815010605]

 

[kaleci]

Hocam ellerinize saglik, tam istedigim gibi oldu. Yardimci oldugunuz icin ne kadar tesekkür etsem azdir. Ben kendim sizin yardiminiz olmaksizin kesinlikle yapamazdim. Adinizda Form' u ayakta tutan bütün arkadaslara tesekkür ederim.

kaleci