自动更新特定单元格，而不是整个列/范围 - VBA

Question

目标

我希望自动更新代码和代码仅考虑特定更改，而不是更新整个列。

说明和问题

C列包含4个不同的值（Type1，Type2，Type3，Type4）。每当用户选择类型时，类型（以数组的形式）在列D中输出该特定行。然后，用户可以在D列中手动更改类型。

如果用户然后在列C中选择一个值，则列D中的所有单元格将自动更新并填充原始值。我不想要这个。只有特定行才能自动更新D列中的类型。

这可能吗？

自动更新代码

Private Sub Worksheet_Change(ByVal Target As Range)        
    If Target.Column = 3 Then
        Call AutoDropdown
    End If
End Sub

代码

Sub AutoDropdown()

Dim PersonSource As Range
Dim PersonSourceTotal As Range
Dim PersonCell As Range
Dim i As Long
Dim lastRow As Long
Dim SelectionArray(1 To 4) As String
Dim ws As Worksheet

arr1 = Array("A", "B", "C", "D")
arr2 = Array("E", "F", "G", "H")
arr3 = Array("I", "J", "K", "L")
arr4 = Array("M", "N", "O", "P")

SelectionArray(1) = Join(arr1, "--")
SelectionArray(2) = Join(arr2, "--")
SelectionArray(3) = Join(arr3, "--")
SelectionArray(4) = Join(arr4, "--")
AllSelections = Join(SelectionArray, ",") 'group all selections for data validation
On Error Resume Next

For Each ws In ThisWorkbook.Worksheets

    If ws.Name = "sheet1" Or ws.Name = "sheet2" Or ws.Name = "sheet3" Then

        Set PersonSourceTotal = ws.Range("D2:D200")

        With PersonSourceTotal.Offset(0, -2)
            lastRow = .Cells(.Rows.Count, PersonSourceTotal.Columns.Count).End(xlUp).Row
        End With

        Set PersonSource = ws.Range("D2:D" & lastRow)

        For Each PersonCell In PersonSource
            Debug.Print (PersonCell)
            varname = PersonCell.Offset(0, -3)
            Debug.Print (varname)
            ID = PersonCell.Offset(0, -2)
                If varname <> "" And ID <> "" Then
                    Select Case PersonCell.Offset(i, -1).Value
                        Case "Type1"
                            With PersonCell.Validation
                            Debug.Print (PersonCell)
                                .Delete
                                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AllSelections
                            End With
                            PersonCell.Value = SelectionArray(1)
                        Case "Type2"
                            With PersonCell.Validation
                                .Delete
                                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AllSelections
                            End With
                            PersonCell.Value = SelectionArray(2)
                        Case "Type3"
                            With PersonCell.Validation
                                .Delete
                                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AllSelections
                            End With
                            PersonCell.Value = SelectionArray(3)
                        Case "Type4"
                        With PersonCell.Validation
                                .Delete
                                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AllSelections
                            End With
                            PersonCell.Value = SelectionArray(4)
                        Case Else
                            MsgBox "No Type was entered on Column C"
                    End Select
                'Else
                '   MsgBox "Remember to add VarName and ID"
                End If
        Next PersonCell
    End If
Next ws
End Sub