Rakamları guruplara ayırmak

[pristineli45]

Arkadaşlar merhaba.
Aşağıdaki kodlarla, A sütununa girdiğim rakamları, okuma kolaylığı sağlaması açısından;

Eğer rakam 7 basamaklıysa, 000 00 00
Eğer rakam 8 basamaklıysa, 000 000 00
Eğer rakam 9 basamaklıysa, 000 000 000
Eğer rakam 10 basamaklıysa, 000 000 00 00
Eğer rakam 11 basamaklıysa, 000 000 000 00
Eğer rakam 12 basamaklıysa, 000 000 000 000

şeklinde guruplara ayırıyor.
Ama çok ilginç bir durum var. Ekli dosyada da görüleceği üzere,sayıları guruplandırırken, ilk 3 rakamı girdikten sonra, 4.rakam 0 (SIFIR) ile başlıyorsa ortaya eksi değerli bir rakam veriyor.Umarım anlatabilmişimdir.
Ekli dosyada B sütununda bulunan rakamları A sütununa girin ve sonucu gözlemleyin.Kırmızı boyalı sütunar haricinde sorun yaşanmıyor..İşin içinden çıkamadım.Sebebi ve çözümü konusunda yardımlarınızı bekliyorum.Şimdiden teşekkürler.

Kodlar şöyle :

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son
If Intersect(Target, Range("A2:A500")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub

If Len(Target) = 7 Then
Target = Format(Target, "###"" ""##"" ""##")
ElseIf Len(Target) = 8 Then
Target = Format(Target, "###"" ""##"" ""###")
ElseIf Len(Target) = 9 Then
Target = Format(Target, "###"" ""###"" ""###")
ElseIf Len(Target) = 10 Then
Target = Format(Target, "###"" ""###"" ""##"" ""##")
ElseIf Len(Target) = 11 Then
Target = Format(Target, "###"" ""###"" ""###"" ""##")
ElseIf Len(Target) = 12 Then
Target = Format(Target, "###"" ""###"" ""###"" ""###")
End If
Columns(Target.Column).EntireColumn.AutoFit
End

son:
End Sub

 

[Ömer]

Merhaba,

İlaveler kırmızı:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo son
    If Intersect(Target, Range("A2:A500")) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub
    
    [COLOR="Red"]Application.EnableEvents = False[/COLOR]
    If Len(Target) = 7 Then
        Target = Format(Target, "###"" ""##"" ""##")
    ElseIf Len(Target) = 8 Then
        Target = Format(Target, "###"" ""##"" ""###")
    ElseIf Len(Target) = 9 Then
        Target = Format(Target, "###"" ""###"" ""###")
    ElseIf Len(Target) = 10 Then
        Target = Format(Target, "###"" ""###"" ""##"" ""##")
    ElseIf Len(Target) = 11 Then
        Target = Format(Target, "###"" ""###"" ""###"" ""##")
    ElseIf Len(Target) = 12 Then
        Target = Format(Target, "###"" ""###"" ""###"" ""###")
    End If
Columns(Target.Column).EntireColumn.AutoFit

[COLOR="Red"]Application.EnableEvents = True[/COLOR]
son:

End Sub

.

 

[pristineli45]

Tamamdır üstat. Teşekkürler.

 

[Murat OSMA]

Teşekkürler Ömer Bey.