Çözüldü Makroda kullanılan kelimeyi Kalın ve Renkli Yapma

[sirkülasyon]

Değerli Ustalarım;
Berat Kandiliniz ve Cumanız Mübarek Olsun.

Sheets("SÖZLEŞME").Range("B16").Value = "b) T.C. Kimlik No : " & k.Offset(0, 3).Value

Sheets("SÖZLEŞME").Range("B37").Value = "11.4. Kesin teminat ve ek kesin teminatın geri verilmesi:" & vbLf & _
"11.4.1. Taahhüdün, sözleşme ve ihale dokümanı hükümlerine uygun olarak yerine getirildiği ve Yüklenicinin bu işten dolayı idareye herhangi bir borcunun olmadığı tespit edildikten sonra, Sosyal Güvenlik Kurumundan alınan ilişiksiz belgesinin İdareye verilmesinin ardından kesin teminat ve varsa ek kesin teminatların tamamı, Yükleniciye iade edilecektir." & vbLf & _
"11.4.2. Yüklenicinin bu iş nedeniyle İdareye ve Sosyal Güvenlik Kurumuna olan borçları ile ücret ve ücret sayılan ödemelerden yapılan kanuni vergi kesintilerinin hizmetin kabul tarihine kadar ödenmemesi durumunda protesto çekmeye ve hüküm almaya gerek kalmaksızın kesin ve ek kesin teminat paraya çevrilerek borçlarına karşılık mahsup edilir, varsa kalanı Yükleniciye iade edilir." & vbLf & _
"11.4.3. Yukarıdaki hükümlere göre mahsup işlemi yapılmasına gerek bulunmayan hallerde; kesin hesap ve kabul tutanağının onaylanmasından itibaren iki yıl içinde idarenin yazılı uyarısına rağmen talep edilmemesi nedeniyle iade edilemeyen kesin teminat mektupları hükümsüz kalır ve düzenleyen bankaya iade edilir. Teminat mektubu dışındaki teminatlar sürenin bitiminde Hazineye gelir kaydedilir."


Yukarıda altı çizilmiş kısımları kalın ve mavi olmasını nasıl sağlayabilirim?
Teşekkür eder saygılarımı sunarım

 

[sirkülasyon]

'Sheets("SÖZLEŞME").Range("B14").Characters(Start:=WorksheetFunction.Search("2.2. Yüklenicinin", Sheets("SÖZLEŞME").Range("B14")), Length:=Len(Sheets("SÖZLEŞME").Range("B14"))).Font.Color = vbRed
'Sheets("SÖZLEŞME").Range("B14").Characters(Start:=WorksheetFunction.Search("2.2. Yüklenicinin", Sheets("SÖZLEŞME").Range("B14")), Length:=Len(Sheets("SÖZLEŞME").Range("B14"))).Font.Bold = True

Kodu ile "2.2. Yüklenicinin" kısmı istenilen bilgiye uygun işlemini yapıyor.
Ancak
Sheets("SÖZLEŞME").Range("B24").Value = "Madde 3 - Sözleşmenin dili" & vbLf & "3.1. Sözleşme Türkçe olarak hazırlanmıştır." kodunda


Sheets("SÖZLEŞME").Range("B24").Characters(Start:=WorksheetFunction.Search("Madde 3 - Sözleşmenin dili", Sheets("SÖZLEŞME").Range("B24")), Length:=Len(Sheets("SÖZLEŞME").Range("B24"))).Font.Color = vbRed
Sheets("SÖZLEŞME").Range("B24").Characters(Start:=WorksheetFunction.Search("Madde 3 - Sözleşmenin dili", Sheets("SÖZLEŞME").Range("B24")), Length:=Len(Sheets("SÖZLEŞME").Range("B24"))).Font.Bold = True


"Madde 3 - Sözleşmenin dili" kısmına işlemi yapması gerekirken "Madde 3 - Sözleşmenin dili 3.1. Sözleşme Türkçe olarak hazırlanmıştır." olarak işlem yapıyor.

Sadece istediğim kısmın işlem görmesi için ne gibi bir işlem yapmalıyım?

 

[yanginci34]

Aşağıda internetten bulduğum bir kodu size göre uyarlamaya çalıştım denermisiniz.

 Dim xHStr As String, xStrTmp As String
    Dim xHStrLen As Long, xCount As Long, I As Long
    Dim xCell As Range
    Dim xArr
    On Error Resume Next
    xHStr = "Madde 3 - Sözleşmenin dili"
    If TypeName(xHStr) <> "String" Then Exit Sub
    Application.ScreenUpdating = False
        xHStrLen = Len(xHStr)
        For Each xCell In Sheets("SÖZLEŞME"). Range("b24")
            xArr = Split(Sheets("SÖZLEŞME"). Range("b24"), xHStr)
            xCount = UBound(xArr)
            If xCount > 0 Then
                xStrTmp = ""
                For I = 0 To xCount - 1
                    xStrTmp = xStrTmp & xArr(I)
                    xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 3
                    xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.Bold = True
                    xStrTmp = xStrTmp & xHStr
                Next
            End If
        Next
    Application.ScreenUpdating = True

 

[sirkülasyon]

Var olasın.
Sıkıntısız çalıştı.
Allah razı olsun

 

[yanginci34]

Var olasın.
Sıkıntısız çalıştı.
Allah razı olsun

Cümlemizden Allah razı olsun hayırlı kandiller hayırlı cumalar

GM 8 d cihazımdan Tapatalk kullanılarak gönderildi

 

[sirkülasyon]

Yalnız bunu bir yerde uygulayabiliyoruz. İkinci uygulama da sıkıntı yaratıyor.
Tekrar teşekkür ederim

 

[muygun]

Merhaba;
Alternatif olsun.
Eki deneyin.
İyi çalışmalar.

Link:
https://dosya.co/zsv45o852se0/sirkülasyon-aranan_veriyi_şekillendir.rar.html

 

[sirkülasyon]

Sayın muygun
Çok çok teşekkür ederim.