Wörter in Tabelle suchen und Markieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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 With RNG.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With 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 With Zelle.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With End If Next Next End If End Sub

Beliebteste Forumthreads (12 Monate)

Wörter in Tabelle suchen und Markieren

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wörter in Tabelle suchen und Markieren

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread