Question

我有一个宏来创建一个新工作表，并根据“主”工作表范围（“A5”）中单元格的值重命名该工作表。

它会停在一个空白区域。我应该添加什么来跳过空白单元格并继续？

Function CheckSheetExists(ByVal name As String)
' checks if a worksheet already exists

Dim retVal As Boolean

retVal = False

For s = 1 To Sheets.Count
    If Sheets(s).name = name Then
        retVal = True
        Exit For
    End If
Next s

CheckSheetExists = retVal

End Function

Sub AutoAddSheet()

Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("Master").Range("A5")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange

    On Error Resume Next

    If CheckSheetExists(MyCell.Value) = False Then

        Sheets("Template").Copy After:=Sheets(Sheets.Count)

        With Sheets(Sheets.Count)
            .name = MyCell.Value
            .Cells(3, 1) = MyCell.Value

        End With
    End If

On Error GoTo 0

MyCell.Hyperlinks.Add Anchor:=MyCell, Address:="", SubAddress:="'" & MyCell.Value & "'!A1"

Next MyCell
End Sub

Answer 1

您需要在循环中添加空白单元格的检查，例如：我在第二行添加了检查（如果在循环结束之前结束） - 它检查单元格中的文本长度：

New Price by Category: fruit

Item:     apple, SKU:      111, Price:      1.00
Item:     orange, SKU:      222, Price:      1.00

New Price by Category: veggie

Item:     lettuce, SKU:      333, Price:      1.50
Item:     carrot, SKU:      444, Price:      1.50

编辑：如果WS存在，我会更改函数检查：

For Each MyCell In MyRange
IF(LEN(MYCELL.VALUE)>0) THEN
    On Error Resume Next

    If CheckSheetExists(MyCell.Value) = False Then

        Sheets("Template").Copy After:=Sheets(Sheets.Count)

        With Sheets(Sheets.Count)
            .name = MyCell.Value
            .Cells(3, 1) = MyCell.Value

        End With
    End If

On Error GoTo 0

MyCell.Hyperlinks.Add Anchor:=MyCell, Address:="", SubAddress:="'" & MyCell.Value & "'!A1"
END IF
Next MyCell

Answer 2

你的问题很可能是这个任务：

Set MyRange = Range(MyRange, MyRange.End(xlDown))

End(xlDown)方法将停留在空白单元格（通常）。

有关查找给定范围内“最后”单元格的更可靠方法，请参阅this other answer。

您可能还想将MyCell.Hyperlinks.Add声明移动到 If CheckSheetExists块，和，您需要添加逻辑以跳过空单元格（如果MyRange中有空单元格。

Sub AutoAddSheet()

Dim MyCell As Range, MyRange As Range

With Sheets("Master")
Set MyRange = .Range("A5")
Set MyRange = .Range(MyRange, .Range("A" & .Rows.Count).End(xlUp))

For Each MyCell In MyRange

    On Error Resume Next

    If CheckSheetExists(MyCell.Value) = False And MyCell.Value <> vbNullString Then

        Sheets("Template").Copy After:=Sheets(Sheets.Count)

        With Sheets(Sheets.Count)
            .name = MyCell.Value
            .Cells(3, 1) = MyCell.Value

        End With
        MyCell.Hyperlinks.Add Anchor:=MyCell, Address:="", SubAddress:="'" & MyCell.Value & "'!A1"
    End If

On Error GoTo 0

Next MyCell
End Sub

Answer 3

怎么样：

For Each MyCell In MyRange
    If MyCell.Value <> "" Then
        On Error Resume Next
            If CheckSheetExists(MyCell.Value) = False Then
                Sheets("Template").Copy After:=Sheets(Sheets.Count)
                With Sheets(Sheets.Count)
                    .Name = MyCell.Value
                    .Cells(3, 1) = MyCell.Value
                End With
            End If
        On Error GoTo 0
        MyCell.Hyperlinks.Add Anchor:=MyCell, Address:="", SubAddress:="'" & MyCell.Value & "'!A1"
    End If
Next MyCell

如何跳过空白单元格？

3 个答案: