Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
996to1000
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Gesuchte Wörter Fett machen

Gesuchte Wörter Fett machen
24.07.2008 13:25:36
Felix
Hallo,
mein Problem:
Es gibt eine Spalte (mit ca. 1200 Zeilen), in der Keywords stehen, meisten 2 oder 3 in einer Zelle. Neben dieser Spalte befinden sich eine andere Spalte, ebenfalls mit Wörtern, meisten so 5 bis 10.
Das Makro soll jetzt die Text-Spalte mit der Keywordsspalte Zeilenweise vergleichen und Wörter, die sowohl in der Text-Spalte als auch in der Keywords-Spalte vorkommen, fett machen (in der Textspalte).Ich habe das
Makro erst mal für den Fall geschrieben, dass es nur eine Textspalte gibt. Ich muss dazu sagen, dass es mein erstes Makro ist und ich mit der VBA Syntax alles andere als vertraut bin.
Mein Problem ist jetzt, dass mein Excel immer abstürzt sobald ich das Programm fahre und ich keine Ahnung habe warum. Vielleicht passt die Syntax einfach irgendwo nicht, aber dann dürfte doch nicht das ganze Excel abstürzen.
Hier mal das Programm:
Sub Woerter_Fett_machen() Dim Row As Long Dim DStr As String Dim BackupStr As String Dim VglStr As String Dim Beginn As Long 'gibt die Stelle im Zellen-Character an, bei der das momentane Suchwort _ steht Dim keywords As Long Dim titel As Long keywords = 4 'gibt die Spalte an, in der die Wörter stehen, mit den verglichen werden _ soll titel = 5 'gibt die Spalte an, in der die Wörter fett gemacht werden sollen For Row = 9 To Cells(65536, 3).End(xlUp).Row DStr = Cells(Row, titel) 'Kompletter Zelleninhalt wird in Variable gespeichert Beginn = 1 Do Until DStr = "" 'Schleife durchführen bis der String leer ist If InStr(DStr, " ") 0 Then 'Fall für mehr als ein Wort VglStr = Trim(Left(DStr, InStr(DStr, " "))) 'Wenn Leerzeichen gefunden wird, _ wird alles was links davon steht im VergleichsString gespeichert If InStr(Cells(Row, keywords), VglStr) 0 Then 'Überprfung ob _ VergleichsString im Keywords-Character vorkommt Cells(Row, titel).Characters(Start:=Beginn, Length:=Beginn + Len(VglStr)). _ _ Font.FontStyle = "Fett" 'wenn Überprüfung erfolgreich, wird das gerade überprüfte Wort Fett _ gemacht Beginn = Beginn + Len(VglStr) + 1 End If Else 'Fall für genau ein Wort VglStr = DStr If InStr(Cells(Row, keywords), VglStr) 0 Then Cells(Row, titel).Characters(Start:=Beginn, Length:=Beginn + Len(VglStr)). _ _ Font.FontStyle = "Fett" Beginn = Beginn + Len(VglStr) + 1 End If End If DStr = Trim(Right(DStr, Len(DStr) - InStr(DStr, " "))) 'Gesuchtes Wort wird _ aus Variable gelöscht Loop Next End Sub


Wäre toll wenn mir jemand weiter helfen könnte.
Gruß und Dank
Felix

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Gesuchte Wörter Fett machen
24.07.2008 14:33:00
Rudi
Hallo,
versuch mal:

Sub KeywordsFett()
Dim lngRow As Long, lngColText As Long
Dim j As Integer, k As Integer
Dim arrKey
Const iColKey As Integer = 4   'Spalte KeyWords
Const lngColText1 As Long = 5  'erste  Spalte Testwörter
Const lngColText2 As Long = 5  'letzte Spalte Testwörter
Application.ScreenUpdating = False
Range(Columns(lngColText1), Columns(lngColText2)).Font.Bold = False
For lngRow = 2 To Cells(Rows.Count, iColKey).End(xlUp).Row
For lngColText = lngColText1 To lngColText2
'Keywords trennen, KeyWords müssen mit Leerzeichen getrennt sein
arrKey = Split(Trim(Cells(lngRow, iColKey)), " ")
If IsArray(arrKey) Then
For j = 0 To UBound(arrKey)
k = InStr(Cells(lngRow, lngColText), arrKey(j))
If k > 0 Then
Cells(lngRow, lngColTest).Characters(k, Len(arrKey(j))).Font.Bold = True
End If
Next j
Else
k = InStr(arrKey, Cells(lngRow, lngColText))
If k > 0 Then
Cells(lngRow, lngColTest).Characters(k, Len(arrKey)).Font.Bold = True
End If
End If
Next lngColTest
Next lngRow
Application.ScreenUpdating = True
End Sub


Gruß
Rudi

Anzeige
AW: Gesuchte Wörter Fett machen
24.07.2008 17:56:52
ransi
Hallo
Für den Fall das die Keywords mehrfach in einer Zelle stehen
Tabelle1

 DE
1MüllerMüller Meier Müller Schulze
2HinzHinz Kunz Testen Müller
3 Müller Meier Hinz Müller Schulze Kunze
4 Schmidt Kunze
5  


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Versuch mal sowas:
Option Explicit

Sub KeywordsFett()
Dim Regex As Object
Set Regex = CreateObject("VbScript.Regexp")
Dim Keywords As Variant
Dim Ziel As Range
Dim Zelle As Range
Dim Treffer
Dim Alle
Set Ziel = Intersect(Range("E1").CurrentRegion, Columns(Range("E1").Column))
Keywords = WorksheetFunction.Transpose(Range("D1:D2"))
With Regex
    .Pattern = "(" & Join(Keywords, "|") & ")"
    .Global = True
    For Each Zelle In Ziel
        Set Alle = .Execute(Zelle.Text)
        For Each Treffer In Alle
            Zelle.Characters(Treffer.firstindex + 1, Len(Treffer)).Font.Bold = True
        Next
    Next
End With
End Sub

ransi
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige