Text in einer Zelle mit Liste Vergleichen und die entsprechenden Worte Fett schreiben VBA Excel?

1 Antwort

Vom Fragesteller als hilfreich ausgezeichnet

Lösungsvorschlag:

Sub optimierer()
   Call FormatKeyWords([Tabelle1!A2:A6], [Tabelle1!C4])
   Debug.Print "Fertig"
End Sub

Public Function FormatKeyWords(rngKeyWords As Range, rngText As Range)
   Dim intStart As Integer
   Dim rngKeyWord As Range

   rngText.Font.FontStyle = "Standard"
   For Each rngKeyWord In rngKeyWords
       intStart = 1
       Do
           intStart = InStr(intStart, rngText.Value, rngKeyWord.Value, vbTextCompare)
           If intStart > 0 Then _
               rngText.Characters(intStart, Len(rngKeyWord.Value)).Font.FontStyle = "Fett"
           intStart = intStart + 1
       Loop While intStart > 1 And intStart <= Len(rngText.Value)
   Next
End Function
Helios4u 
Fragesteller
 25.08.2021, 06:33

Erst einmal vielen lieben Dank für die schnelle Antwort. Für die Tabellen setze ich einmal meine Liste ein und für die Andere (Tabelle1!C4)?

0
Helios4u 
Fragesteller
 25.08.2021, 06:53

Habe das Ganze jetzt ausprobiert. Es funktioniert auch, wird jetzt der gesamte kopierte Text "Fett" geschrieben. Ich will nur, dass aus diesem zu kopierenden Text nur die Wörter "Fett" geschrieben werden, die in der Liste stehen.

Also die Liste ist Beispielsweise:

Haus

Auto

Baum

Der Text original: Das Auto fährt gegen den Baum (in einer Zelle).

Der Text nach dem Kopieren sollte dann wie folgt aussehen:

Das Auto fährt gegen den Baum (auch in einer Zelle).

1
Suboptimierer  25.08.2021, 07:38
@Helios4u

In meinem Test hatte es funkioniert, weil ich in der Wortliste keine leeren Zellen hatte.

Diese müssen anscheinend abgefangen werden:

Public Function FormatKeyWords(rngKeyWords As Range, rngText As Range)
  Dim intStart As Integer
  Dim rngKeyWord As Range

  rngText.Font.FontStyle = "Standard"
  For Each rngKeyWord In rngKeyWords
    If Not IsEmpty(rngKeyWord) Then

      intStart = 1
      Do
          intStart = InStr(intStart, rngText.Value, rngKeyWord.Value, vbTextCompare)
          If intStart > 0 Then _
              rngText.Characters(intStart, Len(rngKeyWord.Value)).Font.FontStyle = "Fett"
          intStart = intStart + 1
      Loop While intStart > 1 And intStart <= Len(rngText.Value)
    End If
  Next
End Function
1
Helios4u 
Fragesteller
 26.08.2021, 09:38

Kann ich das Thema irgendwo als erledigt abhaken?

0
Suboptimierer  26.08.2021, 09:39
@Helios4u

Du kannst noch die Hilfreichste Antwort auszeichnen und / oder als Ergänzung schreiben, dass es sich erledigt hat. Das ist aber kein Muss.

0