Belirlenen hücre aralığına sadece sayısal veri girişi

[zırzır]

Arkadaşlar,aşağıdaki kodu "gd50:hn73" hücre aralığını kapsayacak şekilde olmasını nasıl sağlarız.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Range("gd50:hn73").Value = 1 Then MsgBox "Merhaba"
End Sub

 

[fedeal]

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim n As Integer, b As Integer
For n = 186 To 222
For b = 50 To 73
If Cells(b, n).Value = 1 Then MsgBox "Merhaba"
Next
Next
End Sub

iyi çalışmalar.

 

[Ayhan Ercan]

Merhaba

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Intersect(Target, Range("gd50:hn73")) Is Nothing Then Exit Sub
If Target = 1 Then MsgBox "Merhaba"
End Sub

 

[fedeal]

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim n As Integer, b As Integer
For n = 186 To 222
For b = 50 To 73
If Cells(b, n).Value = 1 Then MsgBox "Merhaba"
Next
Next
End Sub

bu şekilde olursa aralığa daha önce yazılmış her 1 için mesaj çıkar eger 1 kere cıkmasını isterseniz.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim n As Integer, b As Integer
For n = 186 To 222
For b = 50 To 73
If Cells(b, n).Value = 1 Then
If Target = 1 Then
MsgBox "Merhaba"
Exit Sub
End If
End If
Next
Next
End Sub

böyle kullanın daha önce girilmiş 1 leri dikkate almaz.

 

[zırzır]

Arkadaşlar verdiğiniz kodları çalıştıramadım."gd50:hn73" aralığında "1" rakkamı olsa dahi "Merhaba"
uyarısı çıkmıyor.

 

[Ayhan Ercan]

Arkadaşlar verdiğiniz kodları çalıştıramadım."gd50:hn73" aralığında "1" rakkamı olsa dahi "Merhaba"
uyarısı çıkmıyor.

Siz ne yapmak istediğinizi açıkca yazmamışsınız...

Arkadaşlar,aşağıdaki kodu "gd50:hn73" hücre aralığını kapsayacak şekilde olmasını nasıl sağlarız.

bu ifade ile ne yapmak istediğiniz belli değil.... Bizler de önce ne yapmak istediğiniz ile ilgili olarak tahminler yürüterek cevap vermeye çalışıyoruz. sonra da siz "Çalıştıramadım-Merhaba uyarısı cıkmıyor" diyorsunuz..

İşin ilginç tarafı ise hala ne yapmak istediğiniz ile ilgili net ve açıklayıcı bilgi yok...

 

[zırzır]

Sayın Ayhan Ercan,"gd50" hücresinde hatalı yazılmış sayı olursa "34-" gibi.Başka bir hücrede ise
"EĞER(EHATALIYSA(GD50/1);1;0) formülü ile sayı hatalı ise "1" , düzgün ise "0" olarak doğruluk testi yapılıyor.Sayfanın kod bölümünde ise

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Range("gd50").Value = 1 Then MsgBox "Merhaba"
End Sub

Kodu çalışarak, hatalı yazılmada "Merhaba" uyarısı çıkıyor.Ancak benim "gd50:hn73" hücreleri için
bu testi yapmam gerekiyor.Bu da zahmetli bir iş.Bu yüzden sayı testinin "gd50:hn73" aralığınıda
kapsaması gerekiyor.

 

[Ayhan Ercan]

Peki bu testi yaparken GD50:HN73 hücreleri arasındaki her "1" rakamı için uyarı verecekmi? Yani bahse konu hücre aralığında 30 tane "1" varsa 30 defa "merhaba" diyecekmi?

 

[zırzır]

GD50:HN73 aralığındaki her hangi birisine hatalı bir sayı yazılırsa diğer hücreye yazmak için tıklandığın-
da "Merhaba" uyarısı çıkacak ve yazan kişi sayıyı düzeltmek zorunda kalacak.

 

[Ayhan Ercan]

Benim 3 nolu mesajımıdaki kodu çalıştırmayı denedinizmi?

 

[zırzır]

Sayın Ayhan Ercan,denedim fakat çalışmadı,siz hücrelere 1 yazıldığı zaman çalışsın diye yapmışsınız,
yukarıda dediğim gibi "GD50:HN73" aralığındaki hücrelere istediğimiz sayıları yazabiliriz,mesela
5'in sağına "-" işaretini hata ile yazarsak 5 sayısı anlamsızlaşır işte bu hatalara meydan vermemek
için test yapılıyor.

 

[Ayhan Ercan]

Kusura bakmayın sayın zırzır,
Ben ne istediğinizi anlayamadım...

 

[zırzır]

Sayın Ayhan Ercan, aşağıda örnek dosya var incelerseniz sevinirim.

 

[Korhan Ayhan]

Selamlar,

Keşke örnek dosyanızı en baştan ekleyip sorunuzu sorsaydınız. Bazen sizler için basit gibi görünen konuları bizler anlamakta zorluk çekiyoruz.

Ayrıca bu işlemi veri doğrulamaylada yapabilirsiniz. Kod kullanmanıza gerek kalmaz.

Ekteki örnek dosyanın ilk sayfasında sizin örneğiniz bulunmaktadır. İkinci sayfada ise veri doğrulama ile yapılmış çözümü bulabilirsiniz.

Aşağıdaki kodu denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    On Error GoTo Son
    If Intersect(Target, [A1:L23]) Is Nothing Then Exit Sub
    If WorksheetFunction.IsNumber(Target) = False Then
    Application.EnableEvents = False
    Target.ClearContents
    Target.Select
    Application.EnableEvents = True
    MsgBox "Lütfen sayısal değerler giriniz !", vbExclamation
    End If
Son:
End Sub

Not: Konu başlığınız tarafımdan düzeltilmiştir.

 

[zırzır]

Sayın Korhan Ayhan,size teşekkür ederim kod tam istediğim gibi olmuş.Gece boyunca çalıştığım
için insan belli bir saatten sonra kendini ifade etmekte zorlanıyor,Bu yüzden yazdığım sorularda
düşüncelerimi doğru ifade ediyorum sanıyordum,sayın Ayhan Ercan,fedeal ve sizden bu durum
için özür dilerim.Saygılar.

 

[zırzır]

Sayın Korhan Ayhan, 14 nolu mesajdaki kodun altına aşağıdaki kodu kopyalayamıyorum ne yapmalıyım.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
End Sub

 

[Korhan Ayhan]

Selamlar,

Sn. zırzır,

Kopyalamamanız için bir sebep yok. Ben eklemiş olduğum örnek dosyaya verdiğiniz kodu kopyaladım ve çalıştı.