Gesuchte Wörter Fett machen
24.07.2008 13:25:36
Felix
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