Question

我试图让一个单元格自动添加到该单元格的数据验证下拉列表中的第一个值。还没有在网上找到任何似乎有效的东西。

当用户输入来自工作簿其他部分的信息时，此 Sub 将被 Private Sub 激活。

我剪掉了应该选择第一个下拉值并将其添加到单元格的代码部分，但事实并非如此。 .Value = 1 对我来说似乎不正确...... 我也无法列出此下拉列表将从中选择的范围，因为这将是动态的。我已经看到多个使用“with”语句的示例，但它们似乎需要此列表将用于操作的范围。

我应该提到单元格“LastProject”已经包含一个下拉列表。

有人有更好的主意吗？

Dim LastProject As Range
    Set LastProject = FoundBMR.Offset(0, 1)

'''Find Last Project Produced for unit
    ''' Function ListSourceRange Required.
    Dim rngSource As Range
        
    rngSource = LastProject
        
    Set rngSource = ListSourceRange(Target)
        If Not rngSource Is Nothing Then
            rngSource.Parent.Activate
        End If
    
    With LastProject
        .ClearContents
        .Validation.Delete
        .Validation.Add Type:=xlValidateList, Formula1:="+" & rngSource
        .Value = rngSource.Cells(1, 1).Value
    End With

Function ListSourceRange(c As Range) As Range
    Dim vType, rng As Range
    On Error Resume Next       'ignore error if no validation
    vType = c.Validation.Type
    On Error GoTo 0            'stop ignoring errors
    
    If vType = 3 Then
        'try to get a source range...
        On Error Resume Next
        Set rng = Range(c.Validation.Formula1)
        On Error GoTo 0
    End If
    Set ListSourceRange = rng 'source range, or Nothing if no range found
End Function

Answer 1

更像这样，但我不确定您对这里的验证列表做了什么？为什么删除然后重新添加？

编辑：经过测试并适合我

Sub Tester()

    Dim c As Range, rngList As Range
    
    Set c = ActiveSheet.Range("A1") 'has a list-based validation
    
    Set rngList = ListSourceRange(c)
    
    If Not rngList Is Nothing Then
        c.Value = rngList.Cells(1).Value
    End If
    
End Sub


'Given a cell, see if it has a validation list, and
'  try to get the source range for the list
Function ListSourceRange(c As Range) As Range
    Dim vType, rng As Range
    On Error Resume Next       'ignore error if no validation
    vType = c.Validation.Type
    On Error GoTo 0            'stop ignoring errors
    
    If vType = 3 Then
        'try to get a source range...
        On Error Resume Next
        Set rng = Range(c.Validation.Formula1)
        On Error GoTo 0
    End If
    Set ListSourceRange = rng 'source range, or Nothing if no range found
End Function

Excel VBA - 选择数据验证下拉列表中的第一项

1 个答案: