iki formülü aynı çalışma sayfasında çalıştırma.

[EGULERYUZ]

aşağıdaki 2 ad.kodu aynı sayfada nasıl kullanabilirim,yardımlarınız için teşekkürler...




Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [A:A,B:B,C:C,D,E:E,AK:AK,AL:AL,AN:AN,AO:AO,AP:AP,AQ:AQ,AR:AR,AS:AS,AT:AT,AV:AV,AW:AW,AZ:AZ,BC:BC,BJ:BJ,BM:BM,BN:BN,BQ:BQ,BV:BV,BW:BW,(F1:F4)I1:I4)AJ1:AJ4)]) Is Nothing Then Exit Sub

Range("F5").Select
MsgBox ("...!!!HOOOPPPSSS!!!...Bu Hücrede Formül Bulunduğundan Veri Girişi Yapılamaz, Lütfen Doğru Kutucuğu Seçin"), vbCritical


End Sub






Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Value <> "" Then
If MsgBox("Değişiklik yapmak istiyormusunuz ?", vbYesNo) = vbYes Then
sifre = InputBox("Şifre girin")
If sifre <> 1 Then
MsgBox "Hatalı Şifre girdiniz"
GoTo son
Else
Exit Sub
End If
End If
son:
Target.Offset(1, 0).Select
End If
End Sub

 

[AdemCan]

Merhabalar;

1.Worksheet_SelectionChange kodlarında sütun aralıkları verildiği için Hücrelerde Formül olmasada mesaj ile uyarı çıkar.

Formüllü hücrelerde uyarı vermesi için;
2.Worksheet_SelectionChange kodlarında
Bu satırı

If Target.Value <> "" Then

Bu şekilde değiştiriniz

If Target.HasFormula Then

Formüllü bir hücre seçtiğinizde mesaj ile uyarı çıkar, formül olmayan hücrelerde uyarı çıkmaz.
Saygılarımla, iyi çalışmalar.

 

[EGULERYUZ]

sayın "faye efsane" bu kodlar tam olarak işimi görüyor ,ben sadece iki kodu aynı sayfada kullanamıyorum bununla ilgili olarak yardımlarınızı bekliyorum,
saygılar bizden
iyi çalışmalar...

 

[AdemCan]

Merhabalar;
2.Worksheet_SelectionChange kodlarında
If Target.Value <> "" Then satırının üzerine 1. koddaki bu satırı ekleyiniz.

If Intersect(Target, [A:A,B:B,C:C,D:D,E:E,AK:AK,AL:AL,AN:AN,AO:AO,AP:AP,AQ:AQ,AR:AR,AS:AS,AT:AT,AV:AV,AW:AW,AZ:AZ,BC:BC,BJ:BJ,BM:BM,BN:BN,BQ:BQ,BV:BV,BW:BW,(F1:F4):(I1:I4):(AJ1:AJ4)]) Is Nothing Then Exit Sub

 

[EGULERYUZ]

Merhabalar;
2.Worksheet_SelectionChange kodlarında
If Target.Value <> "" Then satırının üzerine 1. koddaki bu satırı ekleyiniz.

If Intersect(Target, [A:A,B:B,C:C,D:D,E:E,AK:AK,AL:AL,AN:AN,AO:AO,AP:AP,AQ:AQ,AR:AR,AS:AS,AT:AT,AV:AV,AW:AW,AZ:AZ,BC:BC,BJ:BJ,BM:BM,BN:BN,BQ:BQ,BV:BV,BW:BW,(F1:F4):(I1:I4):(AJ1:AJ4)]) Is Nothing Then Exit Sub

bukodu eklediğimde döngüye giriyor ve hiç bir işlrm yapamıyorum,
ilk kod formüllü alanlara girişi engellemek için kullanıyorum ikincisini f5 ile aj24 arasındaki hücrelere veri değişimi için diğer hücreler verileri başka bir çalışma kitabından alıyor.bu yaptığımız değişiklik hiç bir hücreye erişim sağlamadı.konuyla ilgil dosya yı ekliyorum bir el atarsanız sevinirim...

http://s5.dosya.tc/server5/gmhsb3/GUNLUK_PUANTAJ_.rar.html

 

[AdemCan]

Merhabalar;
Dosya indirme yetkim olmadığından dolayı Çalışma Dosyanıza bakamıyorum. İndiren arkadaşlar yardımcı olacaktır.
Saygılarımla, iyi çalışmalar.

 

[EGULERYUZ]

sayın faye efsane ,dosyaya bakmanız için upload sitelerine yükledim indirmek isterseniz ordan ulaşabilirsiniz...

http://s5.dosya.tc/server5/gmhsb3/GU...NTAJ_.rar.html

 

[AdemCan]

Merhabalar;
Hiç aralık belirtmeden, hem dolu hücreleri hem de formüllü hücreleri aşağıdaki şekilde kontrol edebilirsiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell <> "" Or ActiveCell.HasFormula Then
If MsgBox("Değişiklik yapmak istiyormusunuz ?", vbYesNo) = vbYes Then
sifre = InputBox("Şifre girin")
If sifre <> 1 Then
MsgBox "Hatalı Şifre girdiniz"
GoTo son
Else
Exit Sub
End If
End If
son:
Target.Offset(1, 0).Select
End If
End Sub

Eğer hücre aralıkları olsun derseniz bu satırı da ekleyiniz.

If Intersect(ActiveCell, [A:A,B:B,C:C,D:D,E:E,AK:AK,AL:AL,AN:AN,AO:AO,AP:AP,AQ:AQ,AR:AR,AS:AS,AT:AT,AV:AV,AW:AW,AZ:AZ,BC:BC,BJ:BJ,BM:BM,BN:BN,BQ:BQ,BV:BV,BW:BW,(F1:F4):(I1:I4):(AJ1:AJ4)]) Is Nothing Then Exit Sub

Saygılarımla, iyi çalışmalar.

 

[EGULERYUZ]

ellerinize sağlık faye efsane,birde şu aralıktaki hücrelerin seçilmesini engelleyebilirsek çok daha güzel olacak.[A:A,B:B,C:C,D,E:E,AK:AK,AL:AL,AN:AN,AO:AO,AP:AP,AQ:AQ,AR:AR,AS:AS,AT:AT,AV:AV,AW:AW,AZ:AZ,BC:BC,BJ:BJ,BM:BM,BN:BN,BQ:BQ,BV:BV,BW:BW,(F1:F4)I1:I4)AJ1:AJ4)]

 

[AdemCan]

Merhabalar;
Kodu bu şekilde değiştiriniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [A:A,B:B,C:C,D:D,E:E,AK:AK,AL:AL,AN:AN,AO:AO,AP:AP,AQ:AQ,AR:AR,AS:AS,AT:AT,AV:AV,AW:AW,AZ:AZ,BC:BC,BJ:BJ,BM:BM,BN:BN,BQ:BQ,BV:BV,BW:BW,(F1:F4):(I1:I4):(AJ1:AJ4)]) Is Nothing Then
MsgBox "Değiştirilmemesi gereken bir hücre seçtiniz!", vbExclamation, "Uyarı"
Range("F5").Select
Exit Sub
End If

If Target.Value <> "" Then
If MsgBox("Değişiklik yapmak istiyormusunuz ?", vbYesNo) = vbYes Then
sifre = InputBox("Şifre girin")
If sifre <> 1 Then
MsgBox "Hatalı Şifre girdiniz"
GoTo son
Else
Exit Sub
End If
End If
son:
Target.Offset(1, 0).Select
End If
End Sub

Saygılarımla, iyi çalışmalar.

 

[EGULERYUZ]

çok çok sağol faye efsane ellerine sağlık....

 

[AdemCan]

Merhabalar;
Rica ederim, iyi çalışmalar.