覆盖数据并仍保留数据下拉列表数据

Question

我想知道是否有可能用新数据覆盖行，但仍将先前的数据保留在下拉列表中？我想做的是遍历关联列表，如果条件为true，则在新行上添加数据，获取数据并创建一个下拉列表，然后移至下一个关联。我拥有的代码可以运行，但是它可以添加到以前的数据中，只是使下拉列表更大。内循环完成后，我还在column（3）上尝试了clearContents，但它清除了以前的下拉列表数据。

        For j = 2 To GetRowLength("HR")
            If shHR.Range("B" & j) = shIS.Range("F" & i) Then
                shHR.Range("C" & GetRowLength("HR", 3) + 1) = shHR.Range("A" & j)
            End If
        Next j

        With shIS.Range("O" & i).Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=HR!$C:$C"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With

    Next i 

Answer 1

您可以改为在Formula1定义中使用动态数组。观看下面的代码，但是我不确定您是否在寻找这个代码：

Dim bAddNewItem As Boolean
Dim arr()

' Fill out an array once somewhere at the beginning of the procedure
arr = Application.Transpose(Sheet("HR").Range("C:C").SpecialCells(xlCellTypeConstants).Value)

' If You want to add new item change to True
bAddNewItem = False

With Selection.Validation
    .Delete
    If bAddNewItem Then
        ReDim Preserve arr(LBound(arr) To UBound(arr) + 1)
        arr(UBound(arr)) = Selection.Value
    End If
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=Join(arr(), ",")
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With