Excel或VBA - 从另一个工作表中的动态列填充下拉列表,没有重复项

时间:2016-05-04 11:11:00

标签: excel vba excel-vba

我不知道这是否可能,但我正在尝试做一些事情,要求我根据列中的项目填充下拉列表和正常的逐个单元格列表在另一张纸上。我知道如何使用常规列来执行此操作,但我想要使用的列会更改长度并且其中包含许多重复值,因为它是一个排序清单。

所以在这张表上,在C5中,

enter image description here 该值应该能够根据第二张表中B列的内容从下拉列表中选择,而且不必滚动重复项。  enter image description here

我很高兴使用VBA或一般excel公式来实现这一目标。我也知道我不认为我已经解释得很好,所以请随时根据需要提示我提供更多信息。

1 个答案:

答案 0 :(得分:1)

这是一个开始。我假设项目列表位于 Sheet2 的某处,从 B1 B1000 。它是O.K.如果范围仅部分填充(根据您的需要调整1000)

代码扫描此列表并构建DV字符串。然后将数据验证应用于 Sheet1 单元 C5

Sub setupDV()
    Dim rSource As Range, rDV As Range, r  As Range, csString As String
    Dim c As Collection

    Set rSource = Sheets("Sheet2").Range("B1:B1000")
    Set rDV = Sheets("Sheet1").Range("C5")
    Set c = New Collection
    csString = ""
    On Error Resume Next
    For Each r In rSource
        v = r.Value
        If v <> "" Then
            c.Add v, CStr(v)
            If Err.Number = 0 Then
                If csString = "" Then
                    csString = v
                Else
                    csString = csString & "," & v
                End If
            Else
                Err.Number = 0
            End If
        End If
    Next r
    On Error GoTo 0

    'MsgBox csString

    With rDV.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=csString
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = False
    End With
End Sub