AW: Hilfe Piet abgelaufener Beitrag
08.02.2017 19:49:14
Piet
Hallo BlueBird
Hallo Michael, Hut ab vor deiner Lösung mit bedingter Formatierung. Eine sehr gute Arbeit. Weil ich mich mit dem Thema nie beschaeftigt habe fehlte mir hierzu das nötige Fachwissen. Ich bin richtig beeindruckt wie einfach diese Aufgabe damit gelöst werden kann!
Hallo BlueBird,
der vollstaendigkeit halber hier noch eine geanderte Makros Lösung von mir. Die Entscheidung was du einsetzen willst liegt bei dir. Im Modulblatt muss natürlich der 1.Befehl Worksheets("Tabelle1").Select auf den richtigen Namen "Laufzettel" geaendert werden. Der unten beigefügte Code gehört natürlich ins Tabellenblatt, er bezieht sich ja auf die Target Funktion!
mfg Piet
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TarTxt As String, TFarbe As Variant
On Error Resume Next
TarTxt = UCase(Target): TFarbe = Farbe
If TarTxt = Empty Then TFarbe = xlNone
Target.Interior.ColorIndex = TFarbe
'suche nach oben nach Text oder "LPHxx"
For j = 1 To 7
If Target.Offset(-j, 0).RowHeight Empty Or LTxt Empty Then
'suche ganzes Wort "Prüfung" oder "Freigabe"
If Txt = "Prüfung" Or Txt = "Freigabe" Then
Target.Offset(-j, 0).Interior.ColorIndex = TFarbe
End If
'suche Text "LPHxx" in String
If InStr(Txt, "LPH 4") Or InStr(Txt, "LPH 5") Or _
InStr(Txt, "LPH4") Or InStr(Txt, "LPH5") Then
Target.Offset(-j, 0).Interior.ColorIndex = TFarbe
End If
'suche L-Text "LPHxx" in Left String (Verundzelle)
If InStr(LTxt, "LPH 4") Or InStr(LTxt, "LPH 5") Or _
InStr(LTxt, "LPH4") Or InStr(LTxt, "LPH5") Then
Target.Offset(-j, -1).Interior.ColorIndex = TFarbe
End If
End If
Next j
'suche nach links mehrere Texte (Pläne)
For j = 1 To 4
If Target.Offset(0, -j).ColumnWidth Empty Then
If Txt = Txt1 Or Txt = Txt2 Or Txt = Txt3 Then
Target.Offset(0, -j).Interior.ColorIndex = TFarbe
Else
'Pläne mit Space und LF im Text
If Left(Txt, 8) = Left(QTxt4, 8) And _
Right(Txt, 12) = Right(QTxt4, 12) Then
Target.Offset(0, -j).Interior.ColorIndex = TFarbe
End If
If Left(Txt, 8) = Left(QTxt5, 8) And _
Right(Txt, 12) = Right(QTxt5, 12) Then
Target.Offset(0, -j).Interior.ColorIndex = TFarbe
End If
End If
End If
If Target.Offset(0, -j).Column = 2 Then Exit For
Next j
End Sub