首页 文章

VBA Excel：如何在基于单元格值创建新工作表时跳过空白单元格

提问于
浏览 次
0

我需要有关VBA的帮助，我有一个允许我创建新工作表的宏，并根据“主”工作表范围（“A5”）中单元格的值重命名该工作表 . 一切正常，但它会停在空白区域 . 我应该添加什么以允许VBA跳过空白单元格并继续？谢谢你的任何建议 . 这是我使用的代码：

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
excel vba excel-vba worksheet

3 回答

  • 0

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

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

    End(xlDown) 方法将在空白单元格（通常）上停止 .

    有关在给定范围内查找"last"单元格的更可靠方法，请参阅this other answer .

    您可能还想在 If CheckSheetExists 块中移动 MyCell.Hyperlinks.Add 语句， and 您需要添加逻辑以跳过空单元格（如果 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
    回复于
  • 0

    怎么样：

    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
    回复于
  • 0

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

    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
    回复于

相关问题