vba - 以编程方式从 Excel 下拉列表中选择

Question

我想编写一个宏，它将从下拉列表(在我的情况下，在单元格 A1 中)中选择一个特定值(在我的情况下，存储在单元格 D6 中)。

这是我到目前为止所拥有的:

sr_par2 = Array ("TEXT", 'TEXT2", "TEXT3")

sr = Range("A1").Value

(...)

Dim i As Integer
i = 0
Range("D6").Select

Do While (sr <> ActiveCell.FormulaR1C1)
    Range("D6").Select
    ActiveCell.FormulaR1C1 = sr_par2(i)
    i = i + 1
Loop

Answer 1

这是你正在尝试的吗？我已经对代码进行了注释，以便您理解它不会有问题。不过，如果你这样做，那么只需问:)

Sub Sample()
    Dim ws As Worksheet
    Dim rngIn As Range, rngOut As Range
    Dim MyAr
    Dim sFormula As String
    Dim i As Long

    '~~> Replace this with the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Set your input and output range here
        Set rngIn = .Range("A1")
        Set rngOut = .Range("D6")

        '~~> Get the validation list if there is one
        On Error Resume Next
        sFormula = rngOut.Validation.Formula1
        On Error GoTo 0

        If sFormula = "" Then
            '~~> If no validation list then directly populate the value
            rngOut.Value = rngIn.Value
        Else
            'validation list TEXT1,TEXT2,TEXT3
            MyAr = Split(sFormula, ",")

            '~~> Loop through the list and compare
            For i = LBound(MyAr) To UBound(MyAr)
                If UCase(Trim(rngIn.Value)) = UCase(Trim(MyAr(i))) Then
                    rngOut.Value = MyAr(i)
                    Exit For
                End If
            Next i

            '~~> Check if the cell is still blank. If it is then it means that
            '~~> Cell A1 has a value which is not part of the list
            If Len(Trim(rngOut.Value)) = 0 Then
                MsgBox "The value in " & rngOut.Address & _
                " cannot be set as the value you are copying is not part of the list"
            End If
        End If
    End With
End Sub