仅当列中的值不在名称中时才添加新的工作表

我很努力地得到这个代码的权利。 我需要为工作表的A列中所列的每个城市创build一个名为“AllCities”的新工作表，但前提是该城市的名称不是以工作表的forms存在。 现在，我的代码将会运行，但是它仍然会将新的工作表添加到最后，而不是将它们命名，只应该添加列中列出的最后几个城市。 我目前的代码如下。

Sub CreateSheetsFromAList() Dim MyCell As Range Dim MyRange As Range With Sheets("AllCities").Range("A2") Set MyRange = Sheets("AllCities").Range("A2") Set MyRange = Range(MyRange, MyRange.End(xlDown)) For Each MyCell In MyRange On Error Resume Next Sheets.ADD After:=Sheets(Sheets.Count) 'creates a new worksheet Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet If Err.Number = 1004 Then Debug.Print MyCell.Value & "already used as sheet name" End If On Error GoTo 0 Next MyCell End With End Sub 

Answer 1

我发现在工作表上开始工作更容易，无论是否存在。 明智的错误控制将暂停处理，当试图在一个不存在的工作表，并允许错误控制创build一个。

 Sub CreateSheetsFromAList() Dim myCell As Range, myRange As Range With Sheets("AllCities") Set myRange = Sheets("AllCities").Range("A2") Set myRange = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)) For Each myCell In myRange On Error GoTo bm_Need_Worksheet With Worksheets(myCell.Value) 'work on the worksheet here End With Next myCell End With Exit Sub bm_Need_Worksheet: With Worksheets.Add(after:=Sheets(Sheets.Count)) 'trap an error on bad worksheet name On Error GoTo 0 .Name = myCell.Value 'prep the worksheet .Cells(1, 1).Resize(1, 9).Formula = "=""fld ""&SUBSTITUTE(ADDRESS(1,COLUMN(), 4, 1), 1, """")" With ActiveWindow .Zoom = 80 .SplitColumn = 0 .SplitRow = 1 .FreezePanes = True End With End With Resume End Sub 

这里的关键是陷阱错误的Resume语句。 它将代码执行返回到抛出错误的行并继续处理。