AW: VBA Dropdown Code anpassen
24.02.2008 03:01:52
fcs
Hallo Lemmi,
ich hab die folgende Prozedur angepasst, so dass die Zelle in Spalte D rot wird, wenn der Zugeordnete Handelsname nicht passt.
Gruß
Franz
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
If Target.Row >= 6 And Target.Cells.Count = 1 Then
Select Case Target.Column
Case 4 'Werkstoff
Target.Interior.ColorIndex = xlColorIndexNone
If Target.Offset(0, 1) "" Then 'Eintrag bei Handelsname ist ausgewählt
If IsEmpty(Target) Then
Target.Interior.Color = vbRed
Else
'Handelsname in Spalte E in Auswahlliste zu Spalte D suchen
Set Zelle = Application.Range("Auswahl_" & Target.Value).Find _
(What:=Target.Offset(0, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then
Target.Interior.Color = vbRed
End If
End If
End If
Case 5 'Werkstoff + Handelsname
Target.Offset(0, -1).Interior.ColorIndex = xlColorIndexNone
If IsEmpty(Target) Then
If Target.Row > 6 Then
'Formeln löschen
Me.Range(Target.Offset(0, 1), Target.Offset(0, 75)).ClearContents
End If
Else
If Target.Row > 6 Then
Application.ScreenUpdating = False
'Formeln aus Zeile 6 kopieren
Range(Cells(6, 5).Offset(0, 1), Cells(6, 5).Offset(0, 75)).Copy
Range(Target.Offset(0, 1), Target.Offset(0, 75)).PasteSpecial Paste:= _
xlPasteFormulas
'Format aus Zeile 6 copieren
Rows(6).Copy
Rows(Target.Row).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Target.Select
Application.ScreenUpdating = True
End If
End If
Case Else
'do nothing
End Select
End If
End Sub