Question

下面的代码应该添加一个新工作表，然后从输入框中为其命名。我已经经历了几次迭代，无法让它发挥作用。

Option Explicit

Dim oWS as Worksheet, sName as String

Again:
    sName = Inputbox ("Enter Sheet Name")
    If sName = vbNull Then Exit Sub

For Each oWs in Worksheets
    If LCase (sName) = LCase (oWS.Name) Then GoTo Again
Next oWS

Set oWS = Worksheets.Add(,ActiveSheet)
End Sub

Answer 1

我会使用Application.InputBox因为如果为空则返回false。代码中包含Goto语句就像是邀请人们来到你的房子脏的时候。最后，添加了一些代码来处理无效的工作表名称。

Sub AddWorksheet()
    Dim result As Variant
    Dim ws As Worksheet

    Do
        result = Application.InputBox(Prompt:="Enter Sheet Name", Title:=IIf(Len(result) = 0, "Create Worksheet", result & " - Exists"), Type:=2)
        If result = False Then Exit Sub
    Loop Until Not WorksheetExists(result)

    Set ws = ThisWorkbook.Worksheets.Add

    On Error Resume Next
    ws.Name = result
    If Err.Number <> 0 Then
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
        If MsgBox("Try Again?", vbYesNo, "Invalid Name") = vbYes Then AddWorksheet
        Exit Sub
    End If
    On Error GoTo 0

End Sub

Function WorksheetExists(result As Variant) As Boolean
    Dim ws As Worksheet
    For Each ws In Worksheets
        If LCase(result) = LCase(ws.Name) Then
            WorksheetExists = True
            Exit Function
        End If
    Next
End Function

Answer 2

我发布时已经实现了答案。将删除问题。现在添加以下答案。我严格这样做是为了练习，所以如果有人知道其他方法来完成这个（并且感觉像分享），我会很乐意审查你的方法！

Option Explicit

Dim oWS as Worksheet, sName as String

Again:
    sName = Inputbox ("Enter Sheet Name")
    If sName = vbNull Then Exit Sub

For Each oWs in Worksheets
    If LCase (sName) = LCase (oWS.Name) Then GoTo Again
Next oWS

Set oWS = Worksheets.Add(,ActiveSheet)
ActiveSheet.Name = sName
End Sub

Answer 3

我要点如下：

Option Explicit

Sub AddNewSheet()
    Dim sName As String

    sName = InputBox("Enter Sheet Name")
    If sName = "" Then Exit Sub

    If Not IsThereSheet(sName) Then Worksheets.Add(, ActiveSheet).Name = sName
End Sub

Function IsThereSheet(sName As String) As Boolean
    On Error Resume Next
    IsThereSheet = Not Worksheets(sName) Is Nothing
End Function

正如您所看到的，不需要循环遍历工作表：只需尝试获取具有给定名称的工作表对象，看看它是否已经存在

另外请注意，在检查之前不需要LCase工作表名称，因为Excel不会让你同时拥有＆＃34; Sheet1＆＃34;和＆＃34; sheet1＆＃34;片

VBA未重命名新工作表

3 个答案: