Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
724to728
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
724to728
724to728
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Bestimmte Wörter/Buchstaben in Zellen färben

Bestimmte Wörter/Buchstaben in Zellen färben
27.01.2006 22:27:01
Michael
Hallo Leute, ich komme einfach nicht weiter. Im Archiv habe ich schon stundenlang gesucht, aber leider nichts passendes gefunden.
In der Spalte B stehen verschiedene Wörter und Begriffe.
In Zelle A4 kann ein Wort oder auch Fragment eingegeben werden. Ziel soll es sein, dass die Wörter der Spalte B:B mit dem eingegebenen Wort/Fragment/Buchstabe der Zelle A4 abgeglichen wird. Die Übereinstimmungen sollen in der Spalte B farblich markiert werden (nicht die Zelle soll gefärbt werden, sondern nur die entsprechenden Buchstaben/Wörter). Über eine Lösung oder Idee wäre ich wirklich dankbar.
Gruss Michael

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bestimmte Wörter/Buchstaben in Zellen färben
27.01.2006 22:36:02
Werner
Hi,
natürlich geht das, stellt sich nur die Frage nach dem praktischen Nutzen?
Warum muss das Wort/Teilwort und nicht die Zelle gefärbt werden?
mfg Werner
AW: Bestimmte Wörter/Buchstaben in Zellen färben
27.01.2006 22:58:09
Michael
Hallo Werner,
die Wörter/Sätze in der Spalte B sind Ergebnisse aus einer Datenbankabfrage. Wenn die Zellen/Zeilen markiert würden, wäre alles markiert und somit überflüssig. Die markierten Fragmente/Wörter sind somit für meinen Zweck sinniger. Über eine Antwort würde ich mich freuen.
Danke und Gruss
Michael
AW: Bestimmte Wörter/Buchstaben in Zellen färben
27.01.2006 22:59:29
Josef
Hallo Michael!
Viel Spass!
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub ColorCharacters()
Dim strFind As String, strText As String
Dim lngRow As Long, lngLast As Long, intIndex As Integer, intLen As Integer

strFind = Trim$(Range("A4").Text)
intLen = Len(strFind)
lngLast = Cells(Rows.Count, 2).End(xlUp).Row
Range("B:B").Font.ColorIndex = xlAutomatic
For lngRow = 1 To lngLast
  intIndex = 0
  If Len(Trim$(Cells(lngRow, 2))) > 0 Then
    strText = Trim$(Cells(lngRow, 2))
    intIndex = InStr(1, LCase(strText), LCase(strFind))
    If intIndex > 0 Then
      Do
        
        Cells(lngRow, 2).Characters(intIndex, intLen).Font.ColorIndex = 3
        intIndex = InStr(intIndex + intLen, LCase(strText), LCase(strFind))
        
      Loop While intIndex > 0
    End If
  End If
Next

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Bestimmte Wörter/Buchstaben in Zellen färben
27.01.2006 23:07:19
Michael
Hallo Josef,
ich bedanke mich herzlich. Es funktioniert super. Vor allem war ich über die schnelle Antwort überrascht. Super!
Gruss Michael
Kleine Korrektur!
27.01.2006 23:17:25
Josef
Hallo nochmal!
Hab einen kleinen fehler entdeckt!
So passt es!
Sub ColorCharacters()
Dim strFind As String, strText As String
Dim lngRow As Long, lngLast As Long, intIndex As Integer, intLen As Integer

strFind = LCase(Trim$(Range("A4").Text))
intLen = Len(strFind)
If Len(strFind) = 0 Then Exit Sub
lngLast = Cells(Rows.Count, 2).End(xlUp).Row
Range("B:B").Font.ColorIndex = xlAutomatic
For lngRow = 1 To lngLast
  intIndex = 0
  If Len(Cells(lngRow, 2)) > 0 Then
    strText = LCase(Cells(lngRow, 2))
    intIndex = InStr(1, strText, strFind)
    If intIndex > 0 Then
      Do
        
        Cells(lngRow, 2).Characters(intIndex, intLen).Font.ColorIndex = 3
        intIndex = InStr(intIndex + intLen, strText, strFind)
        
      Loop While intIndex > 0
    End If
  End If
Next

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Kleine Korrektur!
27.01.2006 23:32:19
Michael
Hallo Sepp,
bis jetzt funktionierte dein erstes Makro. Ich werde das letztere übernehmen, das Du mir geschickt hast. Also nochmals besten Dank für Deinen Einsatz und Deine Mühe!
Gruss Michael

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige