使用VBA添加行时，创build一个下拉列表

我想写一个macros，如下所示：如果在列A下input一个值，它会在列B下的同一行中给出一个下拉列表。

我已经写了一个第一次运作的peice。 但问题是，当我运行它，如果已经在一些单元格下拉列表，它打破了！

Sub Macro2() Dim cell As Range 'If a value is listed For Each cell In ActiveSheet.Range("A2:A1000") If cell.Value <> "" Then cell.Offset(0, 1).Select If Selection = Empty Then With Selection.Validation 'add list box .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=Sheet1!A2:A20" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End If End If Next cell End Sub 

我应该补充说，我不能删除B列中的内容，因为我不想失去已经存在的工作。

Answer 1

为什么不在添加新数据之前清除现有的数据validation？

沿着这些线路：

  With Selection.Validation ' delete existing .Delete 'add list box .Add Type etc. 

Validation.Delete与单击数据validation对话框中的“全部清除”function相同。 没有单元格内容被更改或删除。

Answer 2

这是一个解决scheme，将删除一个validation，然后加回来。 另外，我删除了使用.Select ，这可能会导致错误。

 Dim isValid As Boolean Sub Macro2() Dim cell As Range 'If a value is listed For Each cell In ActiveSheet.Range("A2:A1000") If cell.Value <> "" Then testIfValidation cell.Offset(0, 1) If IsEmpty(cell.Offset(0, 1)) And Not isValid Then With cell.Offset(0, 1).Validation 'add list box .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=Sheet1!A2:A20" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End If End If Next cell End Sub Private Sub testIfValidation(ByVal cel As Range) Dim X As Variant On Error Resume Next X = cel.Validation.Type On Error GoTo 0 If IsEmpty(X) Then Debug.Print cel.Address & " has no validation" isValid = False Else isValid = True End If End Sub 

我更新了这个testing，看看一个单元格是否有validation。 如果有，它会跳过它。 否则，照常进行。