如果名称不存在循环,如何添加工作表

时间:2016-03-30 23:44:04

标签: excel vba

您好我正在尝试创建一个循环,以查看输入是否与现有工作表的名称匹配。

如果是,那么我希望sub重新启动(因此要求用户提供新状态)。

如果输入没有匹配,那么我想要添加一个新工作表。我已经完成了大部分工作,但是当它创建一个新工作表时,它会r-eloops并且只添加空白工作表。

请让我知道你的想法!!

Sub partA()
Dim State As Worksheet
Dim StateName As String
Dim NameExist As Boolean
Dim HQ As String
Dim BO As Integer
Dim Sales As Integer

On Error Resume Next
'Asking for sheet name and then adding one if there is no match
StateName = InputBox("Please Enter a State Name", "State Name")

  For Each State In ActiveWorkbook.Worksheets
        If UCase(StateName) = UCase(State.Name) Then
           NameExist = True
    MsgBox "Worksheet " & StateName & " Exists"
           ElseIf NameExist = False Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = StateName
        End If
    Next State

End Sub

3 个答案:

答案 0 :(得分:0)

只需将其打包在Do ... Loop中,然后在找到唯一名称后退出:

Sub partA()
    Dim State As Worksheet
    Dim StateName As String
    Dim NameExist As Boolean
    Dim HQ As String
    Dim BO As Integer
    Dim Sales As Integer

    'Asking for sheet name and then adding one if there is no match
    Do
        StateName = InputBox("Please Enter a State Name", "State Name")
        NameExist = False
        For Each State In ActiveWorkbook.Worksheets
            If UCase(StateName) = UCase(State.Name) Then
                NameExist = True
                MsgBox "Worksheet " & StateName & " Exists"
                Exit For
            End If
        Next State
    Loop Until NameExist = False

    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = StateName

End Sub

答案 1 :(得分:0)

最好直接测试现有纸张而不是在每张纸上循环。

此外,我删除了冗余变量,并更改了InputBox(强制使用字符串)。

Sub ReCut()
Dim State As Worksheet
Dim StateName As String

StateName = Application.InputBox("Case Sensitive", "Please Enter a State Name", , , , , , 2)
On Error Resume Next
Set State = Sheets(StateName)
On Error GoTo 0

If State Is Nothing Then
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = StateName
Else
    MsgBox "Worksheet " & StateName & " Exists"
End If

End Sub

答案 2 :(得分:-2)

也许这个Sub和这个功能可以帮到你。

Function Find_Sheet(Name_Sheet As String) As Boolean
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = Name_Sheet Then
                   Find_Sheet = True
            Exit Function
        End If
    Next
    Find_Sheet = False
End Function

Sub MySub()

Dim Name_Sheet As String
Name_Sheet = Range("a1").Value
Var = Find_Sheet(Name_Sheet)
If Var = True Then
    MsgBox "It Sheet Exists"
Else
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Name_Sheet
    MsgBox "Sheet " & Name_Sheet & " was created"
End If
End Sub