Excel satırlarda sadece bold olan kelimeleri sütunlara ayırmak

[byoflove]

Arkadaşlar merhaba;
Elimide 30.000 satırlık bir liste var. Listenin ilk kelimesi yada 2 kelimesi Bold olarak yazılmış diğer kelimeler normal. Satırda bold olarak yazılmış kısmı ayrı bir sütuna bölmek istiyorum. Bununla ilgili bir koşul bulamadım.


Örnek aşağıdaki gibi burada sadece bold olanları bir sütuna kalanı başka bir sütuna bölmek istiyorum
Ahmet bugün okula gitti
Kiraz çiçeği faydalı bir bitkidir

 

[Ömer BARAN]

Merhaba.
İlgili sayfanın kod bölümüne yapıştırıp çalıştırın.

Sub KOYU_AYIR()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = 2 To Cells(Rows.Count, "A").End(3).Row
    For k = 1 To Len(Cells(sat, "A"))
10      If Cells(sat, "A").Characters(Start:=k + 1, Length:=1).Font.FontStyle = "Normal" Then
            Cells(sat, "B").Font.Bold = True: Cells(sat, "B") = Trim(Mid(Cells(sat, "A"), 1, k - 1))
            Cells(sat, "C") = Trim(Mid(Cells(sat, "A"), k + 1, Len(Cells(sat, "A"))))
            Exit For
        Else: k = k + 1: GoTo 10
        End If
    Next
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı.", vbInformation, "..:: Ömer BARAN ::.."
End Sub

 

[turist]

Sayın byoflove
Alternatif olarak:
Linkteki Örnek dosyayı indirip inceleyiniz.
Dosya Linki

 

[byoflove]

Merhaba.
İlgili sayfanın kod bölümüne yapıştırıp çalıştırın.

Sub KOYU_AYIR()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = 2 To Cells(Rows.Count, "A").End(3).Row
    For k = 1 To Len(Cells(sat, "A"))
10      If Cells(sat, "A").Characters(Start:=k + 1, Length:=1).Font.FontStyle = "Normal" Then
            Cells(sat, "B").Font.Bold = True: Cells(sat, "B") = Trim(Mid(Cells(sat, "A"), 1, k - 1))
            Cells(sat, "C") = Trim(Mid(Cells(sat, "A"), k + 1, Len(Cells(sat, "A"))))
            Exit For
        Else: k = k + 1: GoTo 10
        End If
    Next
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı.", vbInformation, "..:: Ömer BARAN ::.."
End Sub

Çok teşekkür ederim. Büyük bir dertten kurtardınız

 

[byoflove]

Her iki örnekte çalışıyor emeğinize sağlık