Wie bekomme ich den Code als Schleife
17.06.2022 18:22:31
Juergen
Wenn in ein der Zellen L bis M was eingetragen wird, sollen die anderen beiden gesperrt, gefärbt werden sind alle 3 leer alle 3 Weis
Mein Code kann das Mittlerweile... nur ist er zu lang für alle Zeilen.
Ich möchte dies nun in einer Schleife oder Ihr habt eine bessere Idee machen, nur wie bekomme ich das hin?
Gruss
Jürgen
Hier meine Mappe
https://www.herber.de/bbs/user/153605.xlsm
Hier mein Code für eine Zeile:
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
If Not Application.Intersect(Target, Range("K30")) Is Nothing Then
If Range("K30").Value = "x" Then
Range("L30:M30").Value = ""
Range("L30:M30").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
Range("K30:M30").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 1
.PatternTintAndShade = 1
End With
End If
End If
If Not Application.Intersect(Target, Range("M30")) Is Nothing Then
If Range("M30").Value = "x" Then
Range("K30:L30").Value = ""
Range("K30:L30").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
Range("K30:M30").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 1
.PatternTintAndShade = 1
End With
End If
End If
If Not Application.Intersect(Target, Range("L30")) Is Nothing Then
If Range("L30").Value = "x" Then
Range("K30,M30").Value = ""
Range("K30,M30").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
Range("K30:M30").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 1
.PatternTintAndShade = 1
End With
End If
End If
'Anzeige