Formül içeren hücrenin sadee bir kısmının fntunu değiştirme

[salihfindik]

Formül içeren hücrenin sadece bir kısmının fontunu değiştirme

Merhaba arkadaşlar;
Benim şöyle bir sorunum var.
=("*"&DayanikliTasinirDefteri!$O2&"*")&DAMGA(10)&"Dayanıklı Taşınır No: "&DayanikliTasinirDefteri!$E2&DAMGA(10)&"Kayıt No-Sıra No: "&DayanikliTasinirDefteri!$C2&DAMGA(10)&DayanikliTasinirDefteri!$F2&"-"&DayanikliTasinirDefteri!$AE2&"-"&SOLDAN(DayanikliTasinirDefteri!$G2;70)&"..."&DAMGA(10)&"Parça No:"&" "&"/"&" "

şeklinde A1 hücresinde bir formül var ve ben bu fomüllü alanın sadece ("*"&DayanikliTasinirDefteri!$O2&"*") yazan kısmının fontunu değiştirmek istiyorum. Ancak Excel bana formülün bu kısımını seçerek fontunu değiştirme imkanı sunmuyor. İstediğimi yapabilmem için bildiğiniz bir yol var mı? Yardımlarınız için şimdiden teşekkürler.

 

[mancubus]

sadece metinler için kısım kısım farklı font uygulanabilir.

ancak formül bir defa hesaplandıktan sonra değere dönüştürülmesinde sizin için problem olmayacaksa aşağıdaki gibi bir önerim olabilir.

bütün formüller yeniden hesaplanır. A1:G500 aralığındaki (dosyadaki gerçek aralığa uyarlanacak tabii) bütün formülleri değere dönüştürür. formüldeki "Dayanıklı Taşınır No" metinsel ifadesinde örnek olarak yazdığım font biçim değişikliklerini yapar.

denemek isterseniz yedek bir dosya üzerinde uygulayın.

Sub kismi_font_degis()

Dim aralık As Range, bul As Range, hücre As Range
Dim arama As String, adres As String
Dim başla As Long, uzunluk As Long

Calculate

arama = "Dayanıklı Taşınır No: "
Set aralık = Range("A1:G100")

For Each hücre In aralık
    hücre = hücre
    Set bul = hücre.Find(arama, LookIn:=xlFormulas, lookat:=xlPart)
    If Not bul Is Nothing Then
        adres = bul.Address
        Do
            başla = InStr(hücre.Value, arama)
            uzunluk = Len(arama)
            With hücre.Characters(Start:=başla, Length:=uzunluk).Font
                .Size = 20
                .Color = vbBlue
                .Name = "times new roman"
                .Bold = True
            End With
            Set bul = hücre.FindNext(bul)
        Loop While Not bul Is Nothing And bul.Address <> adres
    End If
Next

End Sub