mevcut kodu sütuna göre uyarlamak

Katılım
3 Nisan 2006
Mesajlar
118
Excel Vers. ve Dili
Vers. 2013 Almanca
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.

Kod:
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

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Kodu çalıştığı sayfayı içeren bir dosya eklermisiniz.
 
Katılım
3 Nisan 2006
Mesajlar
118
Excel Vers. ve Dili
Vers. 2013 Almanca
Hocam hemen basit bir sey hazirladim ve gönderiyorum
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
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]
 
Katılım
3 Nisan 2006
Mesajlar
118
Excel Vers. ve Dili
Vers. 2013 Almanca
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

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
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]
 
Katılım
3 Nisan 2006
Mesajlar
118
Excel Vers. ve Dili
Vers. 2013 Almanca
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
 
Üst