Excel Makro: Karakter aralığını Kalın yazı karakterlerine koyma

Yapmak istediğim şey: Son sütunda çok fazla metin bulunan yaklaşık 1400 satır veri var. İşte ne demek istediğimi gösteren bir resim: resim kaldırıldı çünkü bir kerede yalnızca 2 bağlantı gönderebiliyorum.

Şimdi, bu metnin okunmasını kolaylaştırmak için, onun bazı kelimelerini cesurlaştırmak istiyorum.

Şu anda aşağıdaki makro var:

Dim range As range
Set range = Application.Selection

Dim boldwords As Variant
boldwords = Array("Atemschutz:", "Körperschutz:", "Handschutz:", "Augenschutz:")


Dim cell As range
For Each cell In range
    For Each bword In boldwords
        foundword = InStr(1, cell.Text, bword, VbCompareMethod.vbTextCompare)
        If foundword <> 0 Then
            cell.Characters(foundword, Len(bworld)).Font.Bold = True
        End If
    Next
Next

1. Seçilen tüm hücreler arasında dolaş
2. koyu yazılması gereken tüm kelimeleri dolaştırın ve hücrede olup olmadıklarını kontrol edin
3. Eğer öyleyse, onları kalın

Şimdi benim Sorunum, bir kez çalıştırdığımda metnim ya tamamen koyulaşıyor ya da boğuluyor Bunun gibi , veya her harfi ayrı bir satıra yerleştirir. Excel ya yavaşlıyor, donuyor ya da ondan sonra bazen çöküyor.

Bunu önlemek için ne yapılabilir?

GÜNCELLEME: Siphor değişken adını düzelttikten sonra, metin artık bozuk değil ama bazen ayrı satırlara bölünüyor, bazen ne demek istediğimi gösteren bir resim var: beni tıkla

Sanırım kodunuzda bir hata var. Len (bworld) olmalı Len (bword) . Vba seçeneklerinde gerekli Değişken bildirimini (Seçenek Açıklaması) etkinleştirmelisiniz. Bu tür hataların bulunmasına yardımcı olur.