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

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