AW: Korrektur
13.12.2021 15:39:08
UweD
Hallo nochmal
ausgeweitet auf Y: BA
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim RNGAsw As Range, RNGA As Range, RNGB As Range, RNG1 As Range, RNG2 As Range
Dim Sp As Integer, Z As Integer, i As Integer, Such As Variant
Set RNGAsw = Range("Y:BA")
Set RNGA = Range("AM:AR")
Set RNGB = Range("AT:AY")
Set RNG1 = Range("B3:V8")
Set RNG2 = Range("B11:V16")
If Not Intersect(RNGAsw, Target) Is Nothing Then
If Target.Rows.Count > 1 Then
MsgBox "Nur eine Zeile auswählen"
Exit Sub
End If
Z = Target.Row
'Reset
Union(RNG1, RNG2).Interior.Pattern = xlNone
' Suchen in Midi
For i = 6 To 1 Step -1
Such = Intersect(RNGA.Rows(Z), RNGA.Columns(6 - i + 1)).Value
If Such "x" And Such "" Then
Sp = WorksheetFunction.Match(Such, RNG2.Rows(i), 0)
With Intersect(RNG2, RNG2.Rows(i), RNG2.Columns(Sp))
.Interior.Color = 65535
End With
End If
Next
' Suchen in Töne
For i = 6 To 1 Step -1
Such = Intersect(RNGB.Rows(Z), RNGB.Columns(6 - i + 1)).Value
If Such "x" And Such "" Then
Sp = WorksheetFunction.Match(Such, RNG1.Rows(i), 0)
With Intersect(RNG1, RNG1.Rows(i), RNG1.Columns(Sp))
.Interior.Color = 65535
End With
End If
Next
End If
End Sub
LG UweD