以编程方式从Excel下拉菜单中select

我想写一个macros，将从下拉列表（在我的情况下，在单元格D6 ）select一个特定的值（在我的情况下，存储在单元格A1 ）。

以下是我到目前为止：

 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 

Answer 2

如果我理解正确，这应该做你想要的：

 sr_par2 = Array("TEXT", "TEXT2", "TEXT3") sr = Range("A1").Value Dim i As Integer i = 0 On Error GoTo Handler Do While (sr <> sr_par2(i)) i = i + 1 Loop Range("D6").FormulaR1C1 = sr_par2(i) Exit Sub Handler: MsgBox "Value not in the list", vbCritical + vbOKOnly, "Value not found"