AW: Wörter in Tabelle suchen und Markieren
02.04.2019 11:21:47
UweD
Hallo
Ausgangssituation:
Wörter| | A |
| 1 | Suchwörter |
| 2 | Strasse |
| 3 | Weg |
| 4 | Postfach |
| 5 | Straße |
| 6 | |
| 7 | |
| 8 | |
| 9 | |
| 10 | |
Tabelle1| | E | F | G | H |
| 3 | | | | |
| 4 | | | | |
| 5 | Kohlenweg | | | |
| 6 | | | | Hauptstraße 19 |
| 7 | | Hauptstraße 19 | | |
| 8 | | | | |
| 9 | | | | |
| 10 | | | | |
| 11 | | | Erwin Müller, Postfach 12, Große Strasse in München | |
| 12 | Kein Inhalt | | | |
| 13 | | Kein Inhalt | | |
| 14 | | | Kein Inhalt | |
| 15 | | | | |
| 16 | Kein Inhalt | | | |
| 17 | | | | |
| 18 | | | | |
| 19 | | | | |
| 20 | | | | |
| 21 | | | | |
| http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip |
http://Hajo-Excel.de/tools.htm
|
| XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007 |
| Add-In-Version 25.14 einschl. 64 Bit |
Das Makro:
Sub Finden()
Dim TB1, RNG, SP As Integer, TB2, Zelle, i As Integer, LR As Integer, Suchwort As String, StNr As Integer
Set TB1 = Sheets("Wörter")
Set TB2 = Sheets("Tabelle1")
SP = 1 'Wörter in Spalte A
Set RNG = TB2.Range("E:H")
'Reset
RNG.Font.ColorIndex = xlAutomatic
If WorksheetFunction.CountA(RNG) > 0 Then
LR = TB1.Cells(TB1.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
For i = 2 To LR
Suchwort = TB1.Cells(i, SP)
For Each Zelle In RNG.SpecialCells(xlCellTypeConstants, 2)
StNr = InStr(LCase(Zelle), LCase(Suchwort))
If StNr > 0 Then
Zelle.Characters(Start:=StNr, Length:=Len(Suchwort)).Font.Color = -16776961 'Rot
End If
Next
Next
End If
End Sub

LG UweD