Hücre biçimlendirme

[nihatsoylu]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With ActiveSheet
For sat = 2 To .Range("B5536").End(3).Row
If Len(.Cells(sat, 2)) = 7 Then
.Cells(sat, 2) = Format(.Cells(sat, 2), "###"" ""##"" ""##")
End If
If Len(.Cells(sat, 2)) = 8 Then
.Cells(sat, 2) = Format(.Cells(sat, 2), "###"" ""##"" ""###")
End If
Next sat
End With
End Sub

Bu kodları dün ynmancy üstadımız verdi ve B sütununa girilen sayı 7 basamaklı ise 3 - 2 - 2 şeklinde(örneğin 123 45 67),8 basamaklı ise 3-2-3 şeklinde(123 45 678) biçimlendiriyor.Ben kendi gayretimle bunu 9 basamaklıları 3-3-3 şeklinde,10 basamaklıları 3-3-4 şeklinde geliştirmek istedim fakat beceremedim.
8 Then ile başlayan kodların End if ten sonrasına;
If Len(.Cells(sat, 2)) = 9 Then
.Cells(sat, 2) = Format(.Cells(sat, 2), "###"" ""###"" ""###")
End If
If Len(.Cells(sat, 2)) = 10 Then
.Cells(sat, 2) = Format(.Cells(sat, 2), "###"" ""###"" ""####")
End If
şeklinde formülü ilerlettim fakat çalışmadı.Formülü nasıl geliştirmeliyim?
Buna bağlı olarak bir sorum da şöyle :
Bu formülü başka bir çalışma kitabında denedim,çalışmadı.Orada F sütunundaki sayıları biçimlendirmek istedim.B5536 kodunu F5536 olarak değiştirdim ama yine de çalışmadı.Şöyle bir ayrıntı geldi aklıma:
Bu formülün çalıştığı kitapta rakamlar 2.satırdan başlıyor,yeni aktarıp çalıştıramadığım kitapta ise 4. satırdan..Buna göre kodu nasıl değiştirmeliyim?
Şimdiden teşekkürler

 

[nihatsoylu]

Arkadaşlar merhaba..ynmcany arkadaşımız mı yine yanıtlayacak,yoksa sizlerden yardım eden olur mu? Gerçekten bilmediğim için soruyorum. Şöyle düşündüm:ilk olarak o arkadaş yanıt verdi diye yine onun mu yanıt vermesini bekliyorsunuz? Ama burası forum..Aynı soruya birkaç kişi bile yanıt veriyor gördüğüm kadarıyla.

 

[nihatsoylu]

Güncellemek için yazıyorum tekrar

 

[Korhan Ayhan]

Selamlar,

Size önerilen kodu ThisWorkbook bölümüne uygulamanız gerekiyor. Bu şekilde yaptığınızda kod çalışmanızda tüm sayfaların F sütununda çalışır. Bu şekilde uygulamak istiyorsanız aşağıdaki ilk kodu deneyiniz. Yok sadece tek bir sayfada bu kodu uygulamak istiyorsanız 2. kodu ilgili sayfanızın kod bölümüne uygulayıp deneyiniz.

1. Kod (Dosyadaki tüm sayfalarda çalışır)

Private Sub [COLOR=red]Workbook_SheetChange[/COLOR](ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("F4:F65536")) 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) = 8 Then
        Target = Format(Target, "###"" ""##"" ""###")
    ElseIf Len(Target) = 9 Then
        Target = Format(Target, "###"" ""###"" ""###")
    ElseIf Len(Target) = 10 Then
        Target = Format(Target, "###"" ""###"" ""####")
    End If
Son:
End Sub

2. Kod (Sadace uygulanan sayfada çalışır.)

Private Sub [COLOR=red]Worksheet_Change[/COLOR](ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("F4:F65536")) 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) = 8 Then
        Target = Format(Target, "###"" ""##"" ""###")
    ElseIf Len(Target) = 9 Then
        Target = Format(Target, "###"" ""###"" ""###")
    ElseIf Len(Target) = 10 Then
        Target = Format(Target, "###"" ""###"" ""####")
    End If
Son:
End Sub

 

[nihatsoylu]

Hocam çok çok teşekkür ederim.Tam istediğim gibi olmuş.