Sayıları ayırmak arasına boşluk koymak

[kykbt]

Arkadaşlar merhaba
A sutununuda yaklaşık 7000 civarı muhasebe kodu olan sayılar var
Örnek:
710 veya 71001084757 gibi rakamlar var.
Yapmak istediğim bu sayıları belirlediğim kurala göre ayırmaktır. Şöyleki
Hücrede sadece 710 var ise bunu sadece 710 olarak aktarsın veya aynı hücrede tutsun
Hücrede 71001084757 var ise bunu 710 01 08 47 57 halinde aktarsın veya aynı hücrede ayırsın.

Bilmeyen için zor bilen için kolay olabilir, ben bilmeyen'im.

Yardımlarınıza şimdiden teşekkür ederim.

 

[Necdet]

Merhaba,

Başka olasılıklar yok mu? örneğin :
700
700 01
700 01 01
700 01 01 01
700 01 01 01 01 gibi?

Yinede muhasebe kodları deyince yukarıdaki gibi olacağını tahmin ettim.
Hücreleri seçtikten sonra aşağıdaki kodları çalıştırın. Düşündüğüm gibi değilse kodlar üzerinde size uygun değişiklikleri yapınız.

Sub Biçimlendir()

    Dim Hcr As Range
    
    If Selection.Count = 1 Then Exit Sub
    Application.ScreenUpdating = False
    
    For Each Hcr In Selection
    
        If Len(Hcr) = 3 Then
            Hcr.NumberFormat = "000"
        ElseIf Len(Hcr) = 5 Then
            Hcr.NumberFormat = "000 00"
        ElseIf Len(Hcr) = 7 Then
            Hcr.NumberFormat = "000 00 00"
        ElseIf Len(Hcr) = 9 Then
            Hcr.NumberFormat = "000 00 00 00"
        ElseIf Len(Hcr) = 11 Then
            Hcr.NumberFormat = "000 00 00 00 00"
        End If
        
    Next Hcr
    Application.ScreenUpdating = True
    
    
End Sub

 

[Orion1]

710 ortada ise ne olacak!?

 

[Necdet]

710 ortada ise ne olacak!?

Muhasebe kodlarından söz ediyor. Burada 710 onun anlamı yok. Bir anlamda IBAN kodlarının TR00 0000 0000 .... gibi kodlanmasını istiyor hocam?

 

[Orion1]

Muhasebe kodlarından söz ediyor. Burada 710 onun anlamı yok. Bir anlamda IBAN kodlarının TR00 0000 0000 .... gibi kodlanmasını istiyor hocam?

Anladım hocam.

 

[kykbt]

Merhaba,

Başka olasılıklar yok mu? örneğin :
700
700 01
700 01 01
700 01 01 01
700 01 01 01 01 gibi?

Yinede muhasebe kodları deyince yukarıdaki gibi olacağını tahmin ettim.
Hücreleri seçtikten sonra aşağıdaki kodları çalıştırın. Düşündüğüm gibi değilse kodlar üzerinde size uygun değişiklikleri yapınız.

Sub Biçimlendir()

    Dim Hcr As Range
   
    If Selection.Count = 1 Then Exit Sub
    Application.ScreenUpdating = False
   
    For Each Hcr In Selection
   
        If Len(Hcr) = 3 Then
            Hcr.NumberFormat = "000"
        ElseIf Len(Hcr) = 5 Then
            Hcr.NumberFormat = "000 00"
        ElseIf Len(Hcr) = 7 Then
            Hcr.NumberFormat = "000 00 00"
        ElseIf Len(Hcr) = 9 Then
            Hcr.NumberFormat = "000 00 00 00"
        ElseIf Len(Hcr) = 11 Then
            Hcr.NumberFormat = "000 00 00 00 00"
        End If
       
    Next Hcr
    Application.ScreenUpdating = True
   
   
End Sub

Necdet hocam Elinize emeğinize sağlık tam da dediğiniz gibi, Çok teşekkür ediyorum..

 

[kykbt]

Necdet hocam Elinize emeğinize sağlık tam da dediğiniz gibi, Çok teşekkür ediyorum..

Arkadaşlar merhaba,
Bu kodlara birde hücrenin içinde rakamlardan sonra boşluk var ise o boşluğu nasıl silebileceğimi ekleyebilirsem muhteşem olacak..

 

[Necdet]

Arkadaşlar merhaba,
Bu kodlara birde hücrenin içinde rakamlardan sonra boşluk var ise o boşluğu nasıl silebileceğimi ekleyebilirsem muhteşem olacak..

Sütunu Seçin
Ctrl+H(bul ve değiştir)
Aranan Boşluk Karekteri
Yerine Konacak için bir şey yazmayın
Tümünü Değiştir

 

[anemis]

Merhaba,

Başka olasılıklar yok mu? örneğin :
700
700 01
700 01 01
700 01 01 01
700 01 01 01 01 gibi?

Yinede muhasebe kodları deyince yukarıdaki gibi olacağını tahmin ettim.
Hücreleri seçtikten sonra aşağıdaki kodları çalıştırın. Düşündüğüm gibi değilse kodlar üzerinde size uygun değişiklikleri yapınız.

Sub Biçimlendir()

    Dim Hcr As Range
   
    If Selection.Count = 1 Then Exit Sub
    Application.ScreenUpdating = False
   
    For Each Hcr In Selection
   
        If Len(Hcr) = 3 Then
            Hcr.NumberFormat = "000"
        ElseIf Len(Hcr) = 5 Then
            Hcr.NumberFormat = "000 00"
        ElseIf Len(Hcr) = 7 Then
            Hcr.NumberFormat = "000 00 00"
        ElseIf Len(Hcr) = 9 Then
            Hcr.NumberFormat = "000 00 00 00"
        ElseIf Len(Hcr) = 11 Then
            Hcr.NumberFormat = "000 00 00 00 00"
        End If
       
    Next Hcr
    Application.ScreenUpdating = True
   
   
End Sub

Necdet Bey cevabınız için teşekkürler..
Markolar ile yeni yeni haşır neşir olmaya çalışan (zaman buldukça tabii) birisi olarak sizin gibi üstadların yazmış oldukları kodları ders çalışır gibi incelemeye çalışıyorum..

Kodunuzdaki Application.ScreenUpdating = True yada false ifadesi ne işe yaramaktadır?
Birde kodunuzdaki If Selection.Count = 1 Then Exit Sub bu ifadeye göre eğer seçilen hücre tek hücre ise biçimlendirme yapmayacak olması lazım değil midir?

 

[Necdet]

Merhaba,

Makro kodları hücreleri değiştirdikçe bu ekrana yansır bu yüzden

Application.ScreenUpdating = True

bu d eğişiklikleri ekranda kodlar çalıştığı sürece gösterme demektir. Taa ki bu kullanımın True değerini belirtene kadar. Belirtmezseniz zaten kodlar bittiğimde sonuçlar ekrana yansır.
Böylelikle her değişimin ekrana yansımasını göstermek kodların çalışma süresini uzatacaktır. Amaç çalışma sürelerini kısaltmak.

İkinci sorunuzda seçilen hücre sayısı sadece 1 adet ise kodları çalıştırmadan çık demek. Yoksa her başka bir hücreye tıklandığında kodlar çalışacaktır.

 

[anemis]

Çok teşekkürler Necdet bey, Kendi yazmaya çalıştığım kodlarıma da özellikle screenupdating kodunu entegre edeyim. Çok yardımcı oldunuz.

 

[Necdet]

Rica ederim, kolay gelsin.

 

[kykbt]

Sütunu Seçin
Ctrl+H(bul ve değiştir)
Aranan Boşluk Karekteri
Yerine Konacak için bir şey yazmayın
Tümünü Değiştir

Hocam merhaba,
Yanlış anlattım sanıyorum.
Örnek;
710 07 02 01 05
710 07 02 03
710 07 02 03 03
710 07 02 03 031
Gibi kodlarda aradaki boşluk kalmalı ancak bazen kodun sonunda boşluk kalıyor.
Sadece en sonda kalan bu boşluğu kaldırmam gerekiyor.
Bunu daha evvel vermiş olduğunuz kodlara ekleyebilirsek çok iyi olacak.
Belki önce sondaki boşluğu kaldırıp sonra aradaki boşlukları oluşturabilirsek gibi bence..

 

[Necdet]

Merhaba,

Neden boşluk koymak zorundasınız, Görüntü olarak boşluk varmış gibi olsa olmuyor mu? Nitekim verdiğim kodlar da bunu yapıyordu.

Boşluklu istiyorsanız aşağıdaki kodları dener misiniz?

Sub Biçimlendir()

    Dim Hcr As Range
    Dim d
    
    Application.ScreenUpdating = False
    
    For Each Hcr In Selection
    
        d = Replace(Trim(Hcr), " ", "")
        
        If Len(d) = 3 Then
            d = Format(d, "000")
            Hcr = d
        ElseIf Len(d) = 5 Then
            d = Format(d, "000 00")
            Hcr = d
        ElseIf Len(Trim(Hcr)) = 7 Then
            d = Format(d, "000 00 00")
            Hcr = d
        ElseIf Len(d) = 9 Then
            d = Format(d, "000 00 00 00")
            Hcr = d
        ElseIf Len(d) = 11 Then
            d = Format(d, "000 00 00 00 00")
            Hcr = d
        End If
        
    Next Hcr
    Application.ScreenUpdating = True
    
    
End Sub