四级数据有效性查询

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim arr As Variant, TargetRow As Integer, ProName As String, d As Object
    Set d = CreateObject("scripting.dictionary")
    With Sheet2
        r = .Cells(Rows.Count, "c").End(3).Row
        arr = .Range("a1:k" & r)
    End With
    With Me
        '        HaveValidationLastRow = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, SearchDirection:=xlPrevious).Row
        With .Range(Cells(2, "a"), Cells(22, "c")).Validation
            .Delete
        End With
    End With
    '    If Target.Row > 12 And Target.Row < HaveValidationLastRow Then
     If Target.Row = 2 Then
    If Target.Column = 1 Then
        TargetRow = Target.Row
        '            ProName = Target.Offset(0, -1).Value
        Call getDataValidation_OverRide1(TargetRow, arr, d, 6, 1)
        Me.Range("b2") = "": Me.Range("c2") = ""
    ElseIf Target.Column = 2 Then
        TargetRow = Target.Row
        ProName = Target.Offset(0, -1).Value
        Call getDataValidation(TargetRow, ProName, arr, d, 6, 7, 2)
        Me.Range("c2") = ""
    ElseIf Target.Column = 3 Then
        TargetRow = Target.Row
        ProName = Target.Offset(0, -1).Value
        Call getDataValidation(TargetRow, ProName, arr, d, 7, 8, 3)
      
    ElseIf Target.Column = 5 Then
        TargetRow = Target.Row
        ProName = Target.Offset(0, -1).Value
        Call getDataValidation(TargetRow, ProName, arr, d, 3, 4, 5)
    ElseIf Target.Column = 6 Then
        TargetRow = Target.Row
        ProName = Target.Offset(0, -1).Value
        If Len(ProName) = 0 Then ProName = Target.Offset(0, -2).Value
        Call getDataValidation(TargetRow, ProName, arr, d, 3, 5, 6)
    ElseIf Target.Column = 7 Then
        TargetRow = Target.Row
        ProName = Target.Offset(0, -1).Value
        If Len(ProName) = 0 Then ProName = Target.Offset(0, -2).Value
        Call getDataValidation(TargetRow, ProName, arr, d, 5, 6, 7)
    ElseIf Target.Column = 8 Then
        TargetRow = Target.Row
        ProName = Target.Offset(0, -1).Value
        If Len(ProName) = 0 Then ProName = Target.Offset(0, -2).Value
        Call getDataValidation(TargetRow, ProName, arr, d, 6, 7, 8)
    ElseIf Target.Column = 9 Then
        TargetRow = Target.Row
        ProName = Target.Offset(0, -1).Value
        If Len(ProName) = 0 Then ProName = Target.Offset(0, -2).Value
        Call getDataValidation(TargetRow, ProName, arr, d, 7, 8, 9)
    ElseIf Target.Column = 11 Then
        TargetRow = Target.Row
        ProName = Target.Offset(0, -9).Value & "," & Target.Offset(0, -8).Value & "," & Target.Offset(0, -7).Value & "," & Target.Offset(0, -6).Value & "," & Target.Offset(0, -5).Value & "," & Target.Offset(0, -4).Value & "," & Target.Offset(0, -3).Value
        For x = 2 To UBound(arr)
            comKeyStr = arr(x, 1) & "," & arr(x, 2) & "," & arr(x, 3) & "," & arr(x, 4) & "," & arr(x, 5) & "," & arr(x, 6) & "," & arr(x, 7)
            If comKeyStr = ProName Then
                d(comKeyStr) = arr(x, 9)
            End If
        Next
        '      If Target.Offset(0, -5).Value = "" Or Target.Offset(0, -4).Value = "" Or Target.Offset(0, -3).Value = "" Then Exit Sub
        With Me
            With .Range(Cells(TargetRow, 11), Cells(TargetRow, 11)).Validation
                .Delete
                If d.Count = 0 Then MsgBox "该【产品名称_材质_规格型号】的组合没有对应的单价,请重新选择!": Exit Sub
                .Add Type:=xlValidateList, Formula1:=Join(d.Items, ",")
                Set d = Nothing
            End With
        End With
    End If
End If
End Sub
Sub getPerInfo()
    Set dic = CreateObject("scripting.dictionary")
    With Sheet2
        r = .Cells(Rows.Count, "c").End(3).Row
        ar = .Range("a1:ao" & r)
        For x = 2 To UBound(ar)
        dic(ar(x, 8)) = x
Next
    End With
    With Sheet11
    .Columns("a:ao").NumberFormatLocal = "@"
    .[a4].Resize(1, 41) = ""
    .[a6].Resize(1, 41) = ""
        emp_name = .[c2]
        row_index = dic(emp_name)
        res_ar = Application.Index(ar, row_index, 0)
        For i = 1 To 20
        .Cells(4, i) = res_ar(i)
        Next
         For i = 21 To 41
         k = k + 1
        .Cells(6, k) = res_ar(i)
        Next
'        .[a4].Resize(1, 41) = res_ar
    End With
End Sub
Sub getDataValidation(TargetRow, ProName, arr, d, col_arrKeyWord, col_dicKeyWord, col_ValidationWrite)
    For x = 3 To UBound(arr)
        '              If arr(x, col_arrKeyWord) = ProName And Len(arr(x, 3)) > 0 Then d(arr(x, col_dicKeyWord)) = ""
        If arr(x, col_arrKeyWord) = ProName Then d(arr(x, col_dicKeyWord)) = ""
    Next
    With Me
        With .Range(Cells(TargetRow, col_ValidationWrite), Cells(TargetRow, col_ValidationWrite)).Validation
            .Delete
            s = d.keys
            If d.Count = 0 Then Exit Sub
            If IsEmpty(s(0)) Then Exit Sub
            .Add Type:=xlValidateList, Formula1:=Join(d.keys, ",")
            .ShowError = False
            Set d = Nothing
        End With
    End With
End Sub

Sub getDataValidation_OverRide1(TargetRow, arr, d, col_dicKeyWord, col_ValidationWrite)
    For x = 3 To UBound(arr)
        d(arr(x, col_dicKeyWord)) = ""
    Next
    With Me
        With .Range(Cells(TargetRow, col_ValidationWrite), Cells(TargetRow, col_ValidationWrite)).Validation
            .Delete
            s = d.keys
            If d.Count = 0 Then Exit Sub
            If IsEmpty(s(0)) Then Exit Sub
            .Add Type:=xlValidateList, Formula1:=Join(d.keys, ",")
            .ShowError = False
            Set d = Nothing
        End With
    End With
End Sub

Sub 单元格区域锁定()
    Range("a12:m12").Locked = True
End Sub