VBATools

Dla przykładu wyobraźmy sobie listę komórek, które zawierają słowo “jajecznicę”. Zadaniem jest aby pogrubić to słowo, jakie zawiera się w całym zadaniu.

Osadzone jest w komórce “A1”

Sub formatuj_wszystkie()
 Call bold_na_wszystkie(Range("a1"), "jajecznicę")
End Sub

Sub bold_na_wszystkie(wartosc As Range, szukaj$)
'MVP OShon from VBATools.pl
 If InStr(1, wartosc.Value, szukaj) > 0 Then
 wartosc.Font.Bold = False
 Dim x&, dl&, gdzie As Variant
 gdzie =Split(Replace(wartosc.Value, ",", " "))
 For x = LBound(gdzie) To UBound(gdzie) - 1
 dl = dl + Len(gdzie(x)) + 1
 If gdzie(x + 1) = szukaj Then _
 wartosc.Characters(Start:=dl + 1, Length:=Len(szukaj)).Font.Bold = True
 Next x
End If
End Sub

W przypadku, kiedy ilość komórek jakim chcemy poddać edycję pogrubienia słowa jest więcej oraz o ile mamy do czynienia z wieloma słowami, które muszą również być poddane pogrubieniu stosujemy zmodyfikowaną procedurę:

Sub formatuj_kontener()
Dim rn As Range
Dim sniadanie() As String, x&
sniadanie = Split("jajka;kura;chleb;jajecznicę;sól;cukier", ";")

For Each rn In Selection 'Range("a1:x100") 'lub stały zakres
rn.Font.Bold = False
 For x = 0 To UBound(sniadanie)
  Call bold_na_wszystkie2(rn, sniadanie(x))
 Next x
Next
End Sub

Sub bold_na_wszystkie2(wartosc As Range, szukaj$)
If InStr(1, wartosc.Value, szukaj) > 0 Then
 Dim y&, dl&, gdzie As Variant
 gdzie = Split(Replace(wartosc.Value, ",", " "))
 For y = LBound(gdzie) To UBound(gdzie) - 1
  dl = dl + Len(gdzie(y)) + 1
  If gdzie(y + 1) = szukaj Then _
   wartosc.Characters(Start:=dl + 1, Length:=Len(szukaj)).Font.Bold = True
 Next y
End If
End Sub

Rys.1 Pogrubienie szukanych wartości

p.s.

Format komórki nie da się wykonać na formułach. Ustawienie pogrubienia, koloru, czcionki da się jedynie wykonać na “gołym” tekście w komórce. To też w tej sytuacji należy skopiować formuły i zamienić na wartości, a następnie poddać edycji po przez procedurę.

(c) Shon Oskar – www.VBATools.pl