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