Makro ile bazı işaretlere sınırlaması koyma

@ozuberk

Klavye üzerinden yazmakta iken bir engelleme mümkün değil.
Değer hücreye yazıldıktan sonra, ENTER veya YÖN TUŞLARI ya da FAREyle başka bir hücre seçili hale geldiğinde bir kontrol yapılabilir.
Çünkü bir hücreden ayrılmadan (yazmakta iken) o hücrenin değeri hala BOŞtur.

Neyin engelleneceği değil de nelerin yazılmasına izin verileceğini belirlemek bence daha anlamlı geliyor bana.
Örneğin "+" veya "!" ya da ":" yahut ";" , bunları bırakın+, !, : , ; , $, ^, %, ', #, (, ), {, }, ?, = gibi sadece klavyede görünen işaretler değil, yok.
doğrudan değilse bile dolaylı olarak ( ALT+... ) yazılabilecek çok sayıda harf ve sayı olmayan özel işaret/sembol şeklinde olabilir.

Bence; örneğin alana sadece a-z/A-Z/0-9/nokta/virgül yazılabilir başka bir şey yazılamasın gibi bir işlem daha anlamlı geliyor bana.
Kontrolün ne zaman yapılabileceğine değindim.
Diyelim istenilen kodlama yapıldı ve A10'a izin verilen karakterlerle birlikte izin verilmeyen karakterleri de içeren bir değer yazılarak ENTER veya diğer şekillerde hücreden ayrılındı (artık hücre değeri BOŞ DEĞİL ve kontrol yapılabilir demektir).

Bu durumda istediğiniz işlem nedir?
Yazılanı bütün olarak silmek mi, sadece yasaklı karakterleri silmek mi vs
.

Üstat dediğiniz gibi a-z/A-Z/0-9/nokta/tire dışında yazılanların hücreden ayrıldıktan sonra silinmesi daha sonra uyarı verilmesi iyi olur.

İlgili sayfanın kod bölümüne şu kodu yapıştırıp, A sütununa bir şeyler yazarak denemeler yapın.

[REPLY] [/REPLY]

Üstat elinize sağlık çok güzel olmuş. İzin verilen karaktere boşluk eklemeyi unutmuşum. Onu ekledim.
Koda birden fazla boşluk var ise bu boşluğu teke düşürecek kodu eklememiz mümkün mü?

Üstat boşluk kaldırma işlemini başka bir kod ile çözdüm. İzin verilen nokta ve tireden birden fazla var ise bunu nasıl teke düşürebiliriz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
Application.EnableEvents = False
On Error Resume Next
For XD = 1 To Target.Rows.Count
XDD = Cells(Target.Row + XD - 1, 1).Value
For k = 1 To Len(XDD)
kod = Asc(Mid(XDD, k, 1))
Select Case kod
Case Asc("0") To Asc("9")
Case Asc("A") To Asc("Z")
Case Asc("a") To Asc("z")
Case Asc(".")
Case Asc("-")
Case Asc(" ")
Case 199
Case 208
Case 214
Case 220 To 222
Case 231
Case 240
Case 246
Case 252 To 254
Case Else
krt = Mid(XDD, k, 1): say = say + 1
Cells(Target.Row + XD - 1, 1).Value = Replace(Cells(Target.Row + XD - 1, 1), krt, "")
mtn = mtn & ", " & krt
End Select
Next
Next
BoslukSil
If say >= 1 Then: MsgBox "Silinen karakterler:" & vbLf & vbLf & Mid(mtn, 2, Len(mtn)), vbCritical
Application.EnableEvents = True
End Sub


Sub BoslukSil()
Dim r1 As Range
Set r1 = Range("A:A")

r1.Replace _
What:=Space(2), _
Replacement:=" ", _
SearchOrder:=xlByColumns, _
MatchCase:=True
Set r1 = r1.Find(What:=Space(2))

If Not r1 Is Nothing Then
Call BoslukSil
End If
End Sub

Sorunu çözdüm. Başka bir öneriniz var ise bilgilendirirseniz sevinirim. Her şey için teşekkür ederim. Elinize sağlık.


Sub NoktaSil()
Dim r1 As Range
Set r1 = Range("A:A")

r1.Replace _
What:=(".."), _
Replacement:=".", _
SearchOrder:=xlByColumns, _
MatchCase:=True
Set r1 = r1.Find(What:=(".."))

If Not r1 Is Nothing Then
Call NoktaSil
End If

Sonuç aldıysanız mesele yok.

Üstat aynı kodu E sütununa da eklemek için nasıl bir değişiklik yapmamız gerekiyor.

Kodun başındaki
If Target.Column <> 1 Then Exit Sub
satırını
If Target.Column <> 1 And Target.Column <> 5 Then Exit Sub
şeklinde değiştirerek deneyin.

Üstat kodu değiştirdim A sütununda çalışıyor, E sütununda çalışmıyor.

Çalışıyor/çalışmıyor demek yerine sorunlu haliyle,
kodları uyguladığınız gerçek belgenizin bir kopyasını foruma eklerseniz çözüm için mesafe kat edilebilir.
Yoksa havanda su döveriz.

İşte bu tür sıkıntılar nedeniyle, en basit soru için bile örnek belge eklenmesini, soruların örnek belgeler üzerinden sorumasını istiyoruz.
Cevaplarımın altıdaki İMZA bölümünde yer alan açıklamaları okuyup, buna göre bir örnek belge eklerseniz iyi olur.

Kodlar aşağıda yer almaktadır.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 And Target.Column <> 5 Then Exit Sub
Application.EnableEvents = False
On Error Resume Next
For XD = 1 To Target.Rows.Count
XDD = Cells(Target.Row + XD - 1, 1).Value
For k = 1 To Len(XDD)
kod = Asc(Mid(XDD, k, 1))
Select Case kod
Case Asc("0") To Asc("9")
Case Asc("A") To Asc("Z")
Case Asc("a") To Asc("z")
Case Asc(".")
Case Asc("-")
Case 199
Case 208
Case 214
Case 220 To 222
Case 231
Case 240
Case 246
Case 252 To 254
Case Else
krt = Mid(XDD, k, 1): say = say + 1
Cells(Target.Row + XD - 1, 1).Value = Replace(Cells(Target.Row + XD - 1, 1), krt, "")
mtn = mtn & ", " & krt
End Select
Next
Next
If say >= 1 Then: MsgBox "Silinen karakterler1:" & vbLf & vbLf & Mid(mtn, 2, Len(mtn)), vbCritical
If say >= 5 Then: MsgBox "Silinen karakterler2:" & vbLf & vbLf & Mid(mtn, 2, Len(mtn)), vbCritical
Application.EnableEvents = True
End Sub

İşte bu olmadı.
Örnek belgeyle desteklenmeyen sorulara pek bakma taraftarı değilim ama cevap da yazmış bulundum.

Siz ise, örnek belge eklememe konusunda ısrar ediyorsunuz.
Bu durumda yapacak çok şey kalmıyor aslında ama en azından biraz açıklama yazayım dedim.

Benim gibi cevap yazanların, doğrudan forum sayfasında klavyeden yazarak çözüm önerilerinde bulunduğunu düşünüyorsunuz anlaşılan.
Ancak yanılıyorsunuz, hatalı/yanıltıcı cevap yazmış olmamak için (her zaman böyle düşünürüm) emek/zaman harcanıyor.

Örneğin size yazdığım cevap için; önce klavyeden yazılabilecek tüm harf/sayı karakterlerini alt alta yazdım ve bunların
ASC karşılığı olan sayısal değerleri buldum (özellikle Türkçe'ye has karakterler nedeniyle işlem biraz daha zahmetli tabi)
önce hücrelere TEK KARAKTER yazarak test ettim, sonra aynı hücrede 1'den fazla ve bir kısmı serbest, bir kısmı yasaklı karakter olacak şekilde bir şeyler yazdım ve kodun ana çatısı ortaya çıkmış oldu. Ardından, ya kullanıcı alana, başka kaynaktan kopyala-yapıştır yaparak toplu veri girişi sağlıyorsa diyerek düşündüm ve ona ilişkin detayların üstünde durdum. Daha sonra dedim ki, bari silinen karakterlerin neler olduğunu da MsgBox ile bildireyim, bunun için de ekleme yaptım vs.

Velhasıl, yazılan cevaplar emek/zaman ürünüdür.
Konu açıp soru soran üyelerimizden de birazcık zahmete katlanıp, F12 tuşuna basarak belgelerini farklı kaydedip, konuyla ilgisi olmayacak alanları ve varsa özel bilgileri temizledikten sonra foruma eklemelerini beklemekteyiz.
Bakın şu anda da çözüm için kafa yoracağıma size bunları açıklamak durumunda kalıyorum.

Biraz daha anlayışlı olmanız gerekmez mi?

Üstat öncelikle sizi uğraştırdığım için kusura bakmayın.

Haklısınız örnek dosya eklemek daha iyi olurdu. Üyeliğim izin vermediği için dosya yüklemesi yapamadım.

Başka kodlarda olduğu gibi ufak bir değişiklikle başka bir alanda da kullanabilirim diye düşündüğümden kaynaklı oldu galiba.

Emeğiniz ve yardımlarınız için tekrar teşekkür ederim.

Örnek Dosya

@ozuberk
Sorularınıza örnek belge eklemenize bir engel yok.
Deneyin isterseniz.

Harici link yerine örnek belgelerin foruma eklenmesini tercih ediyoruz.
Malum harici dosya paylaşım sitelerindeki linklerin ömrü uzun değil.

Çözüm belgeniz ekte.

A veya E sütunlarına
-- elle yazarak,
-- başka bir yerden kopyala yapıştır yaparak
kural içi/dışı karakterler içeren bir şeyler yazarak denersiniz.

Dosya yükleme ve indirme işleminde aşağıdaki hatayı almaktayım.

Bu dosyayı indirebilmek için Excel Destek üyeliğinizi VIP Üyeliğe yükseltmeniz gerekmektedir.

Merhaba arkadaşlar VIP üyelerden ricam ekli dosyadaki kodları paylaşabilirler mi?

Yardımcı olacak kimse yok mu?

Beyefendi, istediğiniz şey size gerçekten makul geliyor mu?