如何跳過空白單元格？

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

您需要在循環中添加空白單元格的檢查，例如：我在第二行中添加了檢查（如果剛好在循環結束之前，則結束了）-它檢查單元格中文本的長度：

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

編輯：我將更改功能檢查，如果WS存在：

Function CheckSheetExists(ByVal name As String) as boolean
dim WS as worksheet

on error resume next
set ws = Worksheet(name)
on error goto 0

if(ws is nothing) then
CheckSheetExists = false
else
CheckSheetExists = true
end if

set ws=nothing

End Function

Answer 2

您的問題可能是此作業：

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

End(xlDown)方法將在空白單元格上停止（通常）。

有關在給定范圍內找到“最后一個”單元格的更可靠方法，請參見此其他答案 。

您可能還需要在 If CheckSheetExists塊內移動MyCell.Hyperlinks.Add語句， 並且您需要添加邏輯以跳過空單元格（如果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