birleştirmede saadece tek bir sutunun bold ve fontunu büyük yapmak

[tahsinanarat]

örnek dosyada a,b ve c sutunlarını birleştirip, saadece c sutunundaki raf numaralarını kalın ve fontunu 20 olarak birleştirmek istiyorum, formül veya kod ile olabilir. Yardımlarınız için şimdiden teşekkür ediyorum. Saygılar

 

[Ali]

E sütunundaki verileriniz seçip aşağıdaki makro çalıştırıp deneyin.

Option Explicit
Sub Kalınyap()
Dim cell As Object
Dim t As Integer
    For Each cell In Selection
        t = Len(cell) - 6
        With cell.Characters(Start:=t, Length:=8).Font
            .FontStyle = "Bold"
            .Size = 20
        End With
    Next cell
End Sub

 

[tahsinanarat]

Ali bey çok teşekkür ediyorum, işime yaradı, bilgi olsun diye sormak istiyorum, 3. sırada değilde ilk veya ikinci satırda yapmak isteseydik kodda nasıl bir değişiklik yapılırdı.

 

[tahsinanarat]

Sn. Ali bey aynı hücrenin 3.sırasındaki, yani bold yapmak istediğimiz karakter sayısı 7 ve yukarı olduğunda altı karakterden sonrasını bold yapmıyor, başka bir çözüm bulunubalir mi?. teşekkürler.

 

[Ali]

Tahsin Bey, bir düşüneyim daha etkin bir çözüm aklıma gelirse eklerim.

 

[Ali]

A,B ve C sütunlarını D sütununda birleştirir ve D sütunundaki son kelimeleri kalın yapar.

Sub Kalınyap()
For a = 2 To [a65536].End(3).Row
Cells(a, 4) = Cells(a, 1) & Chr(10) & Cells(a, 2) & Chr(10) & Cells(a, 3)
Cells(a, 4).NumberFormat = "@"
Next
For a = 2 To [d65536].End(3).Row
For b = Len(Cells(a, 4)) To 1 Step -1
deger = Mid(Cells(a, 4), b, 1)
If deger = Chr(10) Then GoTo 10
birlestir = deger & birlestir
Next
10 With Cells(a, 4).Characters(Start:=b, Length:=Len(Cells(a, 4))).Font
.Bold = True
.Size = 20
End With
birlestir = ""
Next
End Sub

 

[tahsinanarat]

Ali bey ilginize çok teşekkür ederim, 3.mesajımdaki sorumu yine soracağım, eğer son kelime değilde ilk veya ortadaki kelimeyi kalın yapmak isteseydik kodda nasıl bir değişiklik olacaktı, öğrenmek için soruyorum. Teşekkürler

 

[Ali]

İlk kelimeyi bold yapmak için

Sub Kalınyap()
For a = 2 To [a65536].End(3).Row
Cells(a, 4) = Cells(a, 1) & Chr(10) & Cells(a, 2) & Chr(10) & Cells(a, 3)
Cells(a, 4).NumberFormat = "@"
Next
For a = 2 To [d65536].End(3).Row
For b = 1 To Len(Cells(a, 4))
deger = Mid(Cells(a, 4), b, 1)
If deger = Chr(10) Then GoTo 10
birlestir = deger & birlestir
Next
10 With Cells(a, 4).Characters(Start:=1, Length:=b).Font
.Bold = True
.Size = 20
End With
birlestir = ""
Next
End Sub

Ortadaki kelimeyi bold yapmak için

Sub Kalınyap()
For a = 2 To [a65536].End(3).Row
Cells(a, 4) = Cells(a, 1) & Chr(10) & Cells(a, 2) & Chr(10) & Cells(a, 3)
Cells(a, 4).NumberFormat = "@"
Next
For a = 2 To [d65536].End(3).Row
For b = 1 To Len(Cells(a, 4))
deger = Mid(Cells(a, 4), b, 1)
If deger = Chr(10) Then GoTo 10
birlestir = deger & birlestir
Next
10 With Cells(a, 4).Characters(Start:=b, Length:=4).Font
.Bold = True
.Size = 20
End With
birlestir = ""
Next
End Sub

 

[tahsinanarat]

Ali bey çok teşekkür ediyorum, aradaki farkları inceleyerek öğrenmeye çalışıyorum. Sağolun. Kolay gelsin.