以编程方式将下拉列表添加到特定的单元格

我想知道如何以编程方式添加下拉列表到Excel工作表的特定单元格使用VBA，我想能够添加一个下拉列表单元格（i，j）为例，并定义列表中的元素。

Answer 1

以编程方式进行：

 With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="Value1;Value2;Value3" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With 

Formula1在列表中的值分隔的列表中; 。

更好的方式（dynamic命名范围）

如果您有一个dynamic的logging列表，您想要在下拉列表中填充，那么使用以下公式定义一个命名范围：

=OFFSET(Sheet1!$A$1;1;0;COUNTA(Sheet1!$A:$A)-1)

假设您的数据在Sheet1 ，并在第一行包含一个标题：

 A1 Header A2 Value1 A2 Value2 A3 Value3 

Answer 2

我终于能够破解它！

 Sub MyVlookUp() Const SpecialCharacters As String = " ,-,." Dim Str As String Dim newStr As String Dim c As Range Dim SrchRng As Range Dim SRng As Range Dim char As Variant Dim newSrchRng As Range Dim i As Long Sheets("VlookUp").Select Range("B7:GZ8000").Select Selection.ClearContents For i = 7 To ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Str = Worksheets("VlookUp").Cells(i, "A").Value newStr = Left(Str, 15) For Each char In Split(SpecialCharacters, ",") newStr = Replace(newStr, char, "") Next Worksheets("data").Activate Set SRng = ActiveSheet.Range("B1", ActiveSheet.Range("B65536").End(xlUp)) SRng.Copy Destination:=Range("E1:E7001") Set SrchRng = Range("E1:E7001") For Each newSrchRng In SrchRng.Cells For Each char In Split(SpecialCharacters, ",") newSrchRng.Value = Replace(newSrchRng.Value, char, "") Next Next Set c = SrchRng.Find(newStr, LookIn:=xlValues, LookAt:=xlPart) If Not c Is Nothing Then firstAddress = c.Address Do Range(Cells(c.Row, 2), Cells(c.Row, 3)).Copy With Worksheets("VlookUp") .Cells(i, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial End With Set c = SrchRng.FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If Next i Worksheets("VlookUp").Activate SrchRng.Clear End Sub