エクセルでドロップダウンまたはコンボボックスから値を選択するようにしたいのですが、その際にリストのデータに以下のように制限をかけたいのですが、可能でしょうか？

コメントの仕様でマクロを作成してみました。

セルの値が変わった場合、関連セルのリストを動的に変更しています。

各列の100行-140行を作業領域に使用しています。

Private Sub Worksheet_Change(ByVal Target As Range)
    
    '// A1:F4だけを対象
    If Intersect(Target, Range("A1:F4")) Is Nothing Then Exit Sub
    '// 複数セルの変更は無視
    If Target.Count <> 1 Then Exit Sub

    Application.EnableEvents = False
    
    Dim lName As String
    Dim i As Long, j As Long
    
    Dim r As Long, c As Long
    c = Target.Column
    
    Dim res As Range
    Dim subList As Range
    
    '// 各列の100行以降をリスト用の作業列にしよう
    Cells(100, c).Resize(40, 1).Clear
    For i = 1 To 4
        Set subList = Cells(100, c).Offset(10 * (i - 1), 0).Resize(6, 1)
        subList.Value = Cells(17, c).Resize(6, 1).Value
    
        j = subList.Row + subList.Count - 1
        For r = 1 To 4
            If Cells(r, c) <> "" Then
                Set res = subList.Find(Cells(r, c), lookat:=xlWhole)
                If Not res Is Nothing Then
                    If res.Value <> Cells(i, c).Value Then
                        res.Resize(6, 1).Value = res.Offset(1, 0).Resize(6, 1).Value
                        j = j - 1
                    End If
                End If
            End If
        Next
    '// リスト用の名前を設定
        lName = "SUB_List" & i & "_" & c
        On Error Resume Next
        ActiveWorkbook.Names(lName).Delete
        On Error GoTo 0
        ActiveWorkbook.Names.Add Name:=lName, RefersToR1C1:="=" & ActiveSheet.Name & "!R" & subList.Row & "C[0]:R" & j & "C[0]"
        
    
    '// 同じ列のセルのリストを設定
        With Cells(i, c)
            .Validation.Delete
            .Validation.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="=" & lName
        End With
    Next
    Application.EnableEvents = True
End Sub

不明な点はコメントください。

Validation.Deleteがうまく実行されない可能性もありますが、私の環境では普通にこれでいけました。

初期処理として、最初だけＡ１に何か書き込むと、リストボックスが生成されます。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    Dim str As String
    
    If Intersect(Target, Range("A1:A4")) Is Nothing Then Exit Sub
    If Target.Count <> 1 Then Exit Sub
    
    For i = 1 To 4
        Cells(i, 1).Validation.Delete
    Next
    
    str = ""
    For i = 17 To 22
        If Cells(i, 1).Value <> Range("A1").Value And _
            Cells(i, 1).Value <> Range("A2").Value And _
            Cells(i, 1).Value <> Range("A3").Value And _
            Cells(i, 1).Value <> Range("A4").Value Then
            str = str & Cells(i, 1).Value & ","
        End If
    Next i
    
    For i = 1 To 4
        With Cells(i, 1).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=Left(str, Len(str) - 1)
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .IMEMode = xlIMEModeNoControl
            .ShowInput = True
            .ShowError = True
        End With
    Next
End Sub