Kredi kartı numaralarını 4 er li ayırma

[altan888]

Merhaba

Çalıştığım şirkette onlarca kredi kartı kullanıyor, kart numaralarını okuması ve takibi açısından kolaylık olması açısında kart numaralarını excelde hücreye girerken 4 er basamaklı şekilde görünmesini istiyorum. Şöyleki
Ben excel ücresine kredi kartı numarasını 111122223333444 şeklinde sayı veya metin biçiminde girersem netsis bana bunun görünümünü 1111 2222 3333 4444 şeklinde görünecek şekilde kendi ayırarak göstersin istiyorum.

Özel biçimden ####-####-####-#### sayı formatını bu şekilde yaptım ancak kart numarasının son basamağını kendisi otomatikman sıfır yapıyor, şöyleki 1111 2222 3333 4444 yerine 1111 2222 3333 4440 yapıyor. Biçimini metne çevirdiğimde ise son basamağı değiştirmiyor anca bitişik yazıyor ve ayırma işlemini yapamadım, 1111 2222 3333 4444 şeklinde ayırarak yazılmasını nasıl yapabilirim. Örnek dosya ektedir. Yardımlarınızı rica ederim. İlgilenen ve yardımcı olanlara teşekkür ederim.

 

[muygun]

Merhaba;
Hücreleri biçimlendir>İsteğe uyarlanmış
#### #### #### ###
veya
#### #### #### ####
Şeklinde düzenleyerek deneyin.
(Kaç karakter veri girdiğiniz tam net değil...)
İyi çalışmalar.

 

[altan888]

Merhaba
Kredi kartlarının üzerinde yazan bildiğimiz 16 basamak olan kart numarası. Benim sorunum 16 'ıncı masamağı sıfır yapmadan 4 erli ayırarak görünümü sağlaması aynı bu şekilde 1111 2222 3333 4444 olduğu gibi.
Sizin dediğiniz gibi #### #### #### #### şeklinde format değişikliği yaptım Ancak yine 16 basamağın son rakamını 4 yazdığım halde kendisi otomatik olarak 0 (sıfır'a) çevirdi bu şekilde 1111 2222 3333 4440 görünüyor yine.

 

[Necdet]

Merhaba,
Sütunu Metin olarak biçimlendirdikten sonra aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayıp dener misiniz?
İşinize yararsa kullanırsınız.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [C:C]) Is Nothing Or Target.Row < 4 Then Exit Sub

Application.EnableEvents = False
Target = Replace(Target, " ", "")
Target.Value = Format(Target, "0000 0000 0000 0000")
Application.EnableEvents = True

End Sub

 

[altan888]

Merhaba,
Sütunu Metin olarak biçimlendirdikten sonra aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayıp dener misiniz?
İşinize yararsa kullanırsınız.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [C:C]) Is Nothing Or Target.Row < 4 Then Exit Sub

Application.EnableEvents = False
Target = Replace(Target, " ", "")
Target.Value = Format(Target, "0000 0000 0000 0000")
Application.EnableEvents = True

End Sub

teşekkürler.