Aralık verme sorunu

[honestman]

Merhaba, ben 5555889966663333 şeklinde lan hesap numaralarını 5555 8899 6666 şeklinde 4 lü gruplar halinda aralarına otomatik boşluk verecek şekilde yazmak istiyordum e bunu da hiçreleri biçimlerdirden isteğe bağlı kısmaından #### #### #### şeklinde komut vererek yaptım fakat sayılar ayrıldıktan sonra sondaki rakam kendiliğinden değişiyor en son rakam 4 se mesela 0 oluyor. Yardımınızı rica ediyorum.

 

[Korhan Ayhan]

Selamlar,

Forumumuza hoşgeldiniz.

Hücrelerinizi "METİN" olarak biçimlendirdikten sonra verilerinizi aralarına boşluk vererek hücreye yazmayı deneyin.

Sayısal verilerde excel 15 karaktere kadar duyarlıdır. Bundan sonra yazacağınız her karakter sıfıra dönüşür. Bu problemi hücre formatını "METİN" olarak ayarlayarak çözebilirsiniz.

 

[honestman]

merhaba, teşekkür ederim hoşbulduk. Benim amacım space tuşu kulanmadan bu 16 haneli sayıların kendiliğinden 4 li gruplar halinde boşluklanması. Bu konuda yardım rica ediyorum.

 

[honestman]

cvap veren yok sanırım.

 

[honestman]

cevap vern yok sanırım.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz. A sütununa veri girdikçe otomatik olarak girilen veri biçimlendirilir.

Kullanılan kod; (İlgili sayfanın kod bölümüne uygulayınız.)

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As String
    On Error GoTo Son
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    Veri = Target.Text
    Application.EnableEvents = False
    Target = Mid(Veri, 1, 4) & " " & Mid(Veri, 5, 4) & " " & Mid(Veri, 9, 4) & " " & Mid(Veri, 13, 4)
Son:
    Application.EnableEvents = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    Selection.NumberFormat = "@"
    Application.EnableEvents = True
End Sub

 

[honestman]

Çok teşekkür ederim istediğim oldu.

 

[halit3]

Korhan Beyin koduna küçük ilave ekledim.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Veri As String
Dim i
Dim yer
On Error GoTo Son
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Veri = Target.Text
Application.EnableEvents = False
For i = 1 To Len(Veri)
yer = yer & Mid(Veri, i, 4) & " "
i = i + 3
Next
Target = yer
Son:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Selection.NumberFormat = "@"
Application.EnableEvents = True
End Sub

 

[honestman]

İlave ne ile ilgili acaba ben pek farkı anlayamadında

 

[halit3]

İlave ne ile ilgili acaba ben pek farkı anlayamadında

kırmızı renkli bölümler 16 karekterden fazlası içinde ayurım yapıyor

 

[honestman]

bişey daha öğrendik teşk.