Thema: Gültigkeitsliste in Abhängigkeit einer Werteliste

ClassModule: Tabelle1

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim iRow As Integer, iCol As Integer
   Dim sVal As String
   If Target.Cells.Count > 1 Then Exit Sub
   If Intersect(Target, Range("A7:D11")) Is Nothing Then Exit Sub
   iCol = Target.Column
   For iRow = 1 To 5
      If IsError( _
         Application.Match( _
         Cells(iRow, iCol).Value, _
         Range(Cells(7, iCol), Cells(11, iCol)), 0)) Then
         If sVal <> "" Then
            sVal = sVal & "," & Cells(iRow, iCol).Value
         Else
            sVal = Cells(iRow, iCol).Value
         End If
      End If
   Next iRow
   If sVal = "" Then
      Range(Cells(7, iCol), Cells(11, iCol)).Validation.Delete
   Else
      For iRow = 7 To 11
         With Cells(iRow, iCol).Validation
            .Delete
            .Add _
            Type:=xlValidateList, _
               AlertStyle:=xlValidAlertStop, _
               Operator:=xlBetween, _
               Formula1:=sVal
            .IgnoreBlank = True
         End With
      Next iRow
   End If
End Sub

Beiträge aus dem Excel-Forum zu den Themen Ereignis und Click