Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1508to1512
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

Bitte um Hilfe von Rudi Maintaire

Bitte um Hilfe von Rudi Maintaire
26.08.2016 13:32:26
Rudi
Servus,
ich habe folgendes Makro von dir in folgendem Beitrage gefunden.
Sub aaaa()
Dim rng As Range, i As Integer
For Each rng In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))  'in A
i = InStr(rng, "R423")
If i > 0 Then
rng.Characters(i, 4).Font.Color = RGB(255, 0, 0)
End If
i = InStr(rng, "R201")
If i > 0 Then
rng.Characters(i, 4).Font.Color = RGB(0, 255, 0)
End If
'etc
Next
End Sub
https://www.herber.de/forum/archiv/1364to1368/1366183_bestimmter_Text_in_Zelle_farbig.html
Vlt. könntest du mir den auf meine Situation anpassen.
In Tabelle2 Spalte A habe ich Einträge, welche in der kompletten Tabelle1 gesucht werden soll und wenn gefunden gefärbt werden sollen.
Mit einer Bedingten Formatierung komme ich leider nicht weiter da ich manchmal in einer Zelle mehrer Einträge habe und auch Zeichen die nicht mit gefärbt werden sollen.
Hier mal meine Liste zum besseren Verstädniss
https://www.herber.de/bbs/user/107851.xlsm
mfg Blue Bird

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bitte um Hilfe von Rudi Maintaire
26.08.2016 13:53:08
Rudi
So vielleicht ?

Sub bla()
Dim zell As Range
Dim rng As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim x As Long
Set ws1 = ThisWorkbook.Worksheets("Tabelle1")
Set ws2 = ThisWorkbook.Worksheets("Tabelle2")
x = 1
Do
If ws2.Cells(x, 1).Value = "" Then Exit Do
Set rng = ws1.UsedRange.Cells
For Each zell In rng
If zell.Value = ws2.Cells(x, 1) Then zell.Interior.ColorIndex = 5
Next
x = x + 1
Loop
End Sub

AW: Bitte um Hilfe von Rudi Maintaire
26.08.2016 14:02:13
Rudi
Servus,
dein Makro nimmt leider nur den Eintrag aus Tabelle2 A1 und nicht alle Einträge aus Tabelle2 Spalte A.
Und es werden in Tabelle1 nur die Zellen gefärbt welche 1 Eintrag haben, welche die 2 oder mehr Einträge haben bleiben unberührt.
mfg Blue Bird
Anzeige
AW: Bitte um Hilfe von Rudi Maintaire
26.08.2016 14:08:53
Rudi
100% nimmt der die beiden Eiträge aus Tabelle 2 bis eine Leere Zelle kommt.

Sub bla()
Dim zell As Range
Dim rng As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim x As Long
Set ws1 = ThisWorkbook.Worksheets("Tabelle1")
Set ws2 = ThisWorkbook.Worksheets("Tabelle2")
x = 1
Do
If ws2.Cells(x, 1).Value = "" Then Exit Do
Set rng = ws1.UsedRange.Cells
For Each zell In rng
If zell.Value Like "*" & ws2.Cells(x, 1).Value & "*" Then zell.Interior.ColorIndex = 10
Next
x = x + 1
Loop
End Sub

AW: Bitte um Hilfe von Rudi Maintaire
26.08.2016 14:16:08
Rudi
Servus,
sorry da hatte ich wohl einen Fehler gemacht, nimmt wirklich alle Einträge.
Allerdings habe ich da noch zwei Sachen die nicht so funktionieren wie gedacht.
1. Färbt das Makro mir die Komplette Zelle B3 auf Tabelle1 auch wenn nur einer der Einträge in Tabelle2 Steht, deswegen dachte ich mir nur die Texte in der Zelle zu färben die auch in Tabelle2 stehen.
2. Wenn ich das Makro erneut ausführe und ein Eintrag der gerade noch da war nun nicht mehr da ist (in Tabelle2), bleibt der Eintrag in Tabelle1 trotzdem gefärbt.
mfg Blue Bird
Anzeige
AW: Bitte um Hilfe von Rudi Maintaire
26.08.2016 15:59:43
Rudi
1. Teilerfärbungen einer Zelle sind m.W. in Excel nicht möglich.
2. vom Entfärben war auch bisher keine Rede.
Dann musst du die Schleifen vertauschen und den Hintergrund zurücksetzen,
wenn kein Wert aus Tabelle2 enthalten ist:
Option Explicit
Sub bla()
Dim zell As Range
Dim rng As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim x As Long
Set ws1 = ThisWorkbook.Worksheets("Tabelle1")
Set ws2 = ThisWorkbook.Worksheets("Tabelle2")
Set rng = ws1.UsedRange.Cells
For Each zell In rng
zell.Interior.Color = vbWhite
x = 1
While ws2.Cells(x, 1).Value  ""
If zell.Value Like "*" & ws2.Cells(x, 1).Value & "*" Then zell.Interior.ColorIndex = 10
x = x + 1
Wend
Next
End Sub

Anzeige
AW: Bitte um Hilfe von Rudi Maintaire
26.08.2016 14:39:12
Rudi
Hallo,
Sub aaaa()
Dim rngMatch As Range, rngC As Range, rngA As Range
Dim lngCol As Long, i As Integer
Application.ScreenUpdating = False
With Tabelle2
Set rngMatch = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each rngA In Tabelle1.UsedRange.Cells
rngA.Font.Color = 0
For Each rngC In rngMatch
lngCol = rngC.Font.Color
i = InStr(rngA, rngC)
If i > 0 Then
rngA.Characters(i, Len(rngC)).Font.Color = lngCol
End If
Next rngC
Next rngA
End Sub
Schriftfarbe der Suchbegriffe in Tabelle2 wie gewünscht einstellen.
Gruß
Rudi
Anzeige
AW: Bitte um Hilfe von Rudi Maintaire
26.08.2016 15:12:55
Rudi
Servus Rudi,
vielen vielen danke für deine Hilfe, das ist genau das was ich gesucht habe.
Nun hätte ich nur noch eine zusätzliche Bitte.
Wie bekomme ich es hin das die Texte auch noch Fett Kursiv werden?
mfg Blue Bird
AW: Bitte um Hilfe von Rudi Maintaire
26.08.2016 15:48:15
Rudi
So
Gruß Basti

Sub aaaa()
Dim rngMatch As Range, rngC As Range, rngA As Range
Dim lngCol As Long, i As Integer
Application.ScreenUpdating = False
With Tabelle2
Set rngMatch = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each rngA In Tabelle1.UsedRange.Cells
rngA.Font.Color = 0
For Each rngC In rngMatch
lngCol = rngC.Font.Color
i = InStr(rngA, rngC)
If i > 0 Then
rngA.Characters(i, Len(rngC)).Font.Color = lngCol
rngA.Characters(i, Len(rngC)).Font.Bold = True
rngA.Characters(i, Len(rngC)).Font.Italic = True
End If
Next rngC
Next rngA
End Sub

Anzeige
nur zum Lernen, Baschti...
28.08.2016 22:40:08
Rudi
Hallo,
.. ein kleiner With-Rahmen drumrum
Sub aaaa()
Dim rngMatch As Range, rngC As Range, rngA As Range
Dim lngCol As Long, i As Integer
Application.ScreenUpdating = False
With Tabelle2
Set rngMatch = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each rngA In Tabelle1.UsedRange.Cells
rngA.Font.Color = 0
For Each rngC In rngMatch
lngCol = rngC.Font.Color
i = InStr(rngA, rngC)
If i > 0 Then
With rngA.Characters(i, Len(rngC)).Font
.Color = lngCol
.Bold = True
.Italic = True
End With
End If
Next rngC
Next rngA
End Sub

Gruß
Rudi
Anzeige
AW: nur zum Lernen, Baschti...
29.08.2016 07:08:47
baschti007
Hallo Rudi
Bringt eine einen wesentlichen unterschied[Geschwindigkeit] oder nur zur Übersichtlichkeit ?
Ab und an nutze ich das auch ;)
Gruß Basti
AW: nur zum Lernen, Baschti...
29.08.2016 11:04:55
Rudi
Hallo,
sowohl als auch.
Das ist als ob du eine Straße entlangläufst und ein grünes Haus suchst.
Dann gehst du an den Anfang der Straße, suchst wieder das grüne Haus und schaust nach, ob es dort gelbe Gardinen gibt.
Dann gehst du an den Anfang der Straße, suchst wieder das grüne Haus mit den gelben Gardinen und schaust nach, ob dort Müller wohnt.
Dann gehst du an den Anfang der Straße, suchst wieder das grüne Haus mit den gelben Gardinen in dem Müller wohnt und schellst an.
Ist allerdings marginal.
Gruß
Rudi
Anzeige
Danke ;)
29.08.2016 11:31:07
baschti007
Hey Danke ;)
Rudi
AW: Danke ;)
29.08.2016 14:21:34
Blue
Servus,
danke euch beiden vielmals!!!!
mfg Blue Bird

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige