Ondalık kısmını farklı biçimlendirme

[bofarchi]

Kullandığım tablolarda çok fazla rakam mevcut. Bu tabloların çıktılarını incelerken göz aldanmasını önlemek için; ondalık kısımdaki rakamları, bulundukları hücrenin yazı tipi boyutundan 3 boy daha küçük yapmak istiyorum.

Örneğin Yazı Tipi Boyutu 12 olan bir hücredeki şu rakamı:
1,234.56 m²
ondalık kısmı 9 olacak şekilde gösterebilir miyiz?
1,234.56 m²

Ya da 8 fontla yazılmış hücredeki şu rakamı;
12,345.67 TL
ondalık kısmı 5lik olacak şekilde
12,345.67 TL olarak yazabilir miyiz?

Yardımlarınız için şimdiden teşekkürler.

 

[bofarchi]

Yardımcı olabiliecek var mı acaba?

 

[bofarchi]

Değerli yöneticiler,

Bu konuda sanırım bir cevap alamayacağım. Yer işgal etmemesi adına konuyu kaldırırsanız sevinirim.

Teşekkürler.

 

[Necdet]

Merhaba,

Rakamsal değerler içerisinde characterts fonksiyonu çalışmadı, excel üzerinde çalıştığımda da çalışmadı.

Bu durumda sizin isteğiniz bir ölçüde karşılanmamış oldu.

Ancak sütundaki değerleri başka bir sütuna metin formatında aktarıp yapmak olası, bu da sizin için ne ölçüde mantıklı olur bilemiyorum.

Böyle düşünürseniz örneği inceleyiniz.

A sütunundaki değerleri B sütununda metin haline getirip kuruş kusmının biçimlendirmesini yapmak olası.

Sub KurusFontKucuk()
    Dim i       As Long, _
        bs      As Integer, _
        txt     As String
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        txt = Format(Cells(i, "A"), "#,##0.00 TL")
        Cells(i, "B") = txt
        bs = Len(Cells(i, "B")) - 4
         With Range("B" & i).Characters(bs, 2)
            .Font.Size = 8
            .Font.Bold = True
            .Font.ColorIndex = 3
        End With
    Next i
End Sub

 

[bofarchi]

Necdet Bey,
Değerli vaktinizi ayırdığınız için çok teşekkür ederim. İki noktada daha yardımınızı rica edeceğim:

1. A sütununda küsürat "0" olduğunda B sütununda sayının tamamı küçük fontta ve atanan renkte oluyor.
2. Bu yöntemde tablolarda değerler farklı sütunlarda yer aldığında her biri için farklı bir modülde mi kodlama yapmalıyım? (Bu sorunu şöyle çözmeye çalışacağım; önce değerleri bir yerde elde edip rapor sayfasına yeni formatlı hallerini taşımayı deneyeceğim. Yapabilirsem yazacağım, örneğin m² ifadesini deneyeceğim.)

Necdet Bey, bu arada 1:siyah, 2:beyaz, 3: kırmızı, 4 de yeşilmiş. Vesileyle öğrenmiş oldum.

Saygılarımla.

 

[Korhan Ayhan]

Selamlar,

Necdet beyin önerdiği kodu denediğimde küsürat olmayan sayılarda 1. maddede bahsettiğiniz sorun oluşmadı.

2. sorunuz için örnek dosya eklerseniz yardımcı olmaya çalışırız.

 

[muygun]

Merhaba,

Rakamsal değerler içerisinde characterts fonksiyonu çalışmadı, excel üzerinde çalıştığımda da çalışmadı.

Bu durumda sizin isteğiniz bir ölçüde karşılanmamış oldu.

Ancak sütundaki değerleri başka bir sütuna metin formatında aktarıp yapmak olası, bu da sizin için ne ölçüde mantıklı olur bilemiyorum.

Böyle düşünürseniz örneği inceleyiniz.

A sütunundaki değerleri B sütununda metin haline getirip kuruş kusmının biçimlendirmesini yapmak olası.

Sub KurusFontKucuk()
    Dim i       As Long, _
        bs      As Integer, _
        txt     As String
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        txt = Format(Cells(i, "A"), "#,##0.00 TL")
        Cells(i, "B") = txt
        bs = Len(Cells(i, "B")) - 4
         With Range("B" & i).Characters(bs, 2)
            .Font.Size = 8
            .Font.Bold = True
            .Font.ColorIndex = 3
        End With
    Next i
End Sub

Necdet bey'den güzel bir çözüm.
Kodlar KTF ye dönüştürülebilirse hem kullanıcının istediği çözüm, hemde sitemiz yeni bir KTF kazanmış olur.

 

[bofarchi]

Selamlar,

Korhan Bey, haklısınız. Sanırım ben kod üzerinde oynama yapınca bazı yerleri bozmuşum. Birinci maddede bahsettiğim küsaratsız olması halinde tamamının format değişikliği hatası kodu tekrar kopyalayınca ortadan kalktı.

İkinci sorumla ilgili olarak; örnek teşkil etmesi için Necdet Bey'in yolladığı dosyaya 3 adet sayfa ekleyerek bir dosya oluşturdum:
1. sayfa: Necdet Bey'den gelen sayfa
2. sayfa "metraj" sayfası
3. sayfa "data"
4. sayfa "rapor"

Örnekteki dosyada iki adet olan imalat kalemi sayısının 500 adet olduğunu düşünelim. Bu sebeple "ondalık kısmını biçimlendirmek" istediğimiz hücreler ayrı ayrı yerlerde. Bu durumda yukarıdaki kodu nasıl kullanmam gerekir. Her bir hücre için ayrı ayrı mı yazmalıyız, ya da benim önceki mesajımda 2.maddede önerdiğim gibi farklı bir "data"da bunları toplayıp "rapor" sayfasına biçimlendirilmiş halini mi getirmeliyiz?

(NOT: Örnekteki dosyada; "metraj" sayfasında yapılacak işin mahallere göre metrajları hazırlanıyor, "data" sayfasında birim fiyat analizleri yapılıp, "rapor" sayfasında sunuluyor. Dosya simülasyon niteliğindedir.)

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kod ondalık ayıracı tesbit etmek için kullanılmıştır. Boş bir modüle ekleyiniz.

Option Explicit
Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
Declare Function GetUserDefaultLCID% Lib "kernel32" ()
Public Const LOCALE_SDECIMAL = &HE
 
Function Oku() ' Bölgesel ayarları okur
    Dim Sembol As String
    Dim iRet1 As Long
    Dim iRet2 As Long
    Dim lpLCDataVar As String
    Dim Pos As Integer
    Dim Ayar As Long
 
    Ayar = GetUserDefaultLCID()
 
    iRet1 = GetLocaleInfo(Ayar, LOCALE_SDECIMAL, lpLCDataVar, 0)
    Sembol = String$(iRet1, 0)
 
    iRet2 = GetLocaleInfo(Ayar, LOCALE_SDECIMAL, Sembol, iRet1)
    Pos = InStr(Sembol, Chr$(0))
    If Pos > 0 Then
    Sembol = Left$(Sembol, Pos - 1)
    Oku = Sembol
    End If
End Function

Aşağıdaki kodu ise yine boş bir modüle ekleyip RAPOR sayfasında çalıştırınız.

Option Explicit
 
Sub KÜSÜRAT_DÜZENLE()
    Dim Alan As Range, Hücre As Range, Veri As String, Küsürat As Byte, Uzunluk As Byte
 
    Set Alan = Range("C6,A8,C10,A12,D17:D19")
 
    Range("C6").Formula = "=metrajlar!F3"
    Range("A8").Formula = "=data!B8"
    Range("C10").Formula = "=metrajlar!F7"
    Range("A12").Formula = "=data!B16"
    Range("D17").Formula = "=C6*A8"
    Range("D18").Formula = "=C10*A12"
    Range("D19").Formula = "=SUM(D17:D18)"
 
    For Each Hücre In Alan
        If Hücre.Address = "$D$17" Then
            Hücre.Value = Left(Range("C6").Text, InStr(1, Range("C6").Text, " ")) * Left(Range("A8").Text, InStr(1, Range("A8").Text, " "))
        ElseIf Hücre.Address = "$D$18" Then
            Hücre.Value = Left(Range("C10").Text, InStr(1, Range("C10").Text, " ")) * Left(Range("A12").Text, InStr(1, Range("A12").Text, " "))
        ElseIf Hücre.Address = "$D$19" Then
            Hücre.Value = CDbl(Left(Range("D17").Text, InStr(1, Range("D17").Text, " "))) + CDbl(Left(Range("D18").Text, InStr(1, Range("D18").Text, " ")))
        End If
        Veri = Hücre.Text
        Hücre.Value = Veri
        If InStr(1, Format(Hücre.Value, Hücre.NumberFormat), ",") > 0 Then
            Küsürat = InStr(1, Format(Hücre.Value, Hücre.NumberFormat), ",") + 1
            If InStr(1, Mid(Format(Hücre.Value, Hücre.NumberFormat), Küsürat, 255), " ") > 0 Then
                Uzunluk = InStr(1, Mid(Format(Hücre.Value, Hücre.NumberFormat), Küsürat, 255), " ") - 1
            End If
            With Hücre.Characters(Küsürat, Uzunluk)
                .Font.Size = Hücre.Font.Size - 3
                .Font.Bold = True
                .Font.ColorIndex = 3
            End With
        End If
    Next
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[bofarchi]

Sn. Korhan Bey,
Vaktiniz ayırıp bu değerli bilgileri paylaştığınız için çok teşekkür ederim. Üç sorum olacak:

1. Rapor sayfasında kodu çalıştırdığımda, küsürat kısmı değil de; binler basamağından sonraki iki rakam değişiyor.
2. Kodu çalıştırınca "rapor"daki sonuçlar text'e dönüştüğü için, metrajları değiştirince sonuç değişmiyor. Kodu tekrar çalıştırınca ise bu sefer hücrenin tamamı 8fontta ve 3colorindex'de oluyor.
3. Küsürat kısmını 8font yerine bulunduğu hücre fontundan 3daha küçük yapabilir miyiz? Örneğin bir hücrenin fontu 24ise küsüratı 21font, hücre 12fontta ise 9font alabilir mi?

Saygılarımla.

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. Ayrıca birde örnek dosya ekledim. İncelermisiniz.

 

[bofarchi]

Sn. Korhan Bey,
Eklemiş olduğunuz dosyayı inceledim ve bir kaç deneme yaptım.

"rapor" sayfasında hata veren hücreleri mavi bulut içine aldım ve yanlarına not ekledim. Kırmızı bulut içindekiler ise maviler gibi text'e dönüşüyor ve ön sayfalarda yaptığım değişiklikleri alamıyor.

Saygılarımla.

 

[Korhan Ayhan]

Selamlar,

Sorun sizin ondalık ayıracınızdan kaynaklanıyor.

İlk önerdiğimiz kod aşağıdaki yapıda düzgün çalışmaktadır.
Binlik ayıraç "."
Ondalık ayıraç ","

#9 nolu mesajımda her türlü ayıraç türünde çalışacak şekilde kodu yeniden düzenledim. İki modülde de farklı kodlar bulunmaktadır. Lütfen açıklamaları dikkatlice inceleyiniz.

 

[bofarchi]

Korhan Bey,
Selamlar.

Elinize sağlık, kodlar çok güzel oldu.
Ancak kodu çalıştırdığımda hücreler text formatına dönüşüyor. Bu sebeple önceki sayfalarda metrajları değiştirmem gerektiğinde bu hücrelerin formülleri bozulduğu için, hesaplanmış yeni halleri için formülleri tekrar yazmam gerekecek. Bu kodu uygulayacağım hücre sayısı (örnek dosyadaki gibi iki tane olmayıp) çok fazla ve formüller de çok karışık olduğu için “küsürat düzenle” kodunu çalıştırdıktan sonra ön sayfalarda yaptığım her değişikliği yansıtmak için “rapor” sayfasında formülleri yeniden güncellemem gerekecek. Bu sebeple bu kodu hücreleri texte dönüştürmeden çalıştırabilir miyiz?

Eğer yapamıyorsak, “yeniden hesapla” adında bir buton ekleyip, küsüratı düzenlenecek tüm hücrelerin formüllerini makro ile baştan hesaplatan başka bir makro hazırlayacağım (bu yöntem pek istenen bir yöntem değil).

Yardımlarınız için yeniden sonsuz teşekkür ederim.

Saygılarımla.

 

[Korhan Ayhan]

Selamlar,

Sn. bofarchi,

İstediğiniz biçimlendirmeyi uygulamak için hücredeki formülü metin (text) formatına dönüştümek zorundasınız. Başka türlü istediğiniz biçimi sayısal değerlere uygulayamazsınız. Belki nette "Arial" gibi istediğiniz biçimi formülleri bozmadan uygulayan özel yazı tipi mevcuttur.

Eğer böyle bir yazı tipi bulamazsanız makro ile her işlemde formülleri yeniden hesaplayan ve istediğiniz biçimi uygulayan bir kod yapısı kullanmalısınız.

Tasarlayacağınız makro kodlarını "RAPOR" sayfasının aktif olması olayına tanımlarsanız "RAPOR" sayfasını her açtığınızda işlemler otomatik olarak gerçekleşecektir.

 

[bofarchi]

Sn. Korhan Bey,
Verdiğiniz açıklayıcı bilgiler ve kodlar için çok teşekkür ederim.
Bu kodları dosyama adapte etmem yaklaşık iki haftamı alacak. Tamamlayınca tekrar yazacağım.
İyi çalışmalar,
Saygılar.

 

[ahmet uysal]

bu işlem makrosuz yapılabilir mi ?

 

[Korhan Ayhan]

Bildiğim kadarıyla yapılamıyor.