如何使用FOR Each Loop来更改代码以避免错误:1004未find单元格

我有一个macros的项目标题名称下方,如果有一个项目,它会使其下拉。 标题在第7行,因此它从第8行开始查找。 代码运行完美,除非头下没有项目。

有时候,用户不需要为工作表添加任何下拉菜单,这样他们就会将标题下的所有行留空。 这对于我正在做的事很好,但会使macros抛出错误,因为没有find项目。

我基本上需要调整我的代码,以便能够停止或退出,如果没有find单元格。 这是我需要调整的macros。

Sub AddDropDowns() Dim cell As Range Dim iDropDown As Long With Worksheets("Sheet1") For Each cell In .Range("B8", .Cells(8, .Columns.Count).End(xlToRight)).SpecialCells(XlCellType.xlCellTypeConstants) AddDropDown Worksheets("DropDownsTT"), iDropDown, cell.Offset(-1).Value, "='" & .Name & "'!" & cell.Resize(WorksheetFunction.CountA(cell.EntireColumn) - 1).Address Next cell End With End Sub 

不知道是否需要这段代码,但macros调用以下子例程:

 Sub AddDropDown(sht As Worksheet, dropDownCounter As Long, header As String, validationFormula As String) With sht.Range("A1").Offset(, dropDownCounter) '<--| reference passed sheet row 1 passed column .Cells(1, 1) = header '<--| write header With .Cells(2, 1).Validation '<--| reference 'Validation' property of cell 1 row below currently referenced one .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=validationFormula .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End With dropDownCounter = dropDownCounter + 1 End Sub 

可以这样做:

 Dim rng As Range '... With Worksheets("Sheet1") On Error Resume Next Set rng = .Range("B8", .Cells(8, .Columns.Count).End( _ xlToRight)).SpecialCells(XlCellType.xlCellTypeConstants) On Error Goto 0 If Not rng Is Nothing Then For Each cell In rng AddDropDown Worksheets("DropDownsTT"), iDropDown, _ cell.Offset(-1).Value, "='" & .Name & "'!" & _ cell.Resize(WorksheetFunction.CountA(cell.EntireColumn) - 1).Address Next cell End If End With 

但是这有点不整洁,所以我可能会使用像这样的东西:

 With Worksheets("Sheet1") For Each cell In .Range("B8", .Cells(8, .Columns.Count).End( xlToRight)) If Len(cell.Value) > 0 Then AddDropDown Worksheets("DropDownsTT"), iDropDown, _ cell.Offset(-1).Value, "='" & .Name & "'!" & _ cell.Resize(WorksheetFunction.CountA(cell.EntireColumn) - 1).Address End If Next cell End With