宏可以创建基于列表的名称的新工作表，但如果重复不创建 [英] Macro excel to create new sheets with names based on a list BUT if repeated do not create

问题描述

我可以使用以下代码（下面）根据所选的名称列表创建其名称，但是当有重复名称的单元格时，它将创建没有名称的表单和通用的sheet ##。我想要的是，如果单元格名称重复或有一个已经有该名称的表（同样的事情）不创建新的表。

  Sub AddSheets（）
 Dim cell As Excel.Range 
 Dim wbToAddSheetsTo As Excel.Workbook 
 
设置wbToAddSheetsTo = ActiveWorkbook 
为每个单元格选择
使用wbToAddSheetsTo 
 .Sheets.Add after：=。Sheets（.Sheets.Count）
 On Error Resume Next 
 ActiveSheet.Name = cell.Value 
如果Err.Number = 1004然后
 Debug.Print cell.Value& 已经用作表单名称
结束如果
错误GoTo 0 
结束
 
结束Sub 
  / pre> 
 
解决方案
在创建工作表之前检查工作表是否存在：
 
 
公共功能WorkSheetExists（SheetName As String，wrkbk As Workbook）As Boolean 
 Dim wrkSht As Worksheet 
 On Error Resume Next 
设置wrkSht = wrkbk .Worksheets（SheetName）'尝试设置工作表的引用。 
 WorkSheetExists =（Err.Number = 0）'是否生成错误 - 真或假？ 
设置wrkSht = Nothing 
错误GoTo 0 
结束功能
  

然后在你的代码中，检查它是否存在之前创建它：

  Sub AddSheets（）
 Dim cell As Excel .Range 
 Dim wbToAddSheetsTo As Excel.Workbook 
 
设置wbToAddSheetsTo = ActiveWorkbook 
对于每个单元格在选择
 **如果没有（WorkSheetExists（cell.Value，wbToAddSheetsTo） ）然后** 
使用wbToAddSheetsTo 
 .Sheets.Add after：=。Sheets（.Sheets.Count）
 On Error Resume Next 
 ActiveSheet.Name = cell.Value 
如果Err.Number = 1004然后
 Debug.Print cell.Value& 已经用作表单名称
结束如果
错误GoTo 0 
结束
 **结束如果** 
下一个单元格
 
 End Sub 
  

I am able to create sheets including its name based on a selected list of "names" with the following code (below), BUT when there are cells with repeated name it will create a sheet without a name and the generic "sheet##". I want that if the cell name is repeated or there is a sheet already with that name (same thing) NOT to create a new sheet.

Sub AddSheets()
Dim cell As Excel.Range
Dim wbToAddSheetsTo As Excel.Workbook

Set wbToAddSheetsTo = ActiveWorkbook
For Each cell In Selection
With wbToAddSheetsTo
    .Sheets.Add after:=.Sheets(.Sheets.Count)
    On Error Resume Next
    ActiveSheet.Name = cell.Value
    If Err.Number = 1004 Then
      Debug.Print cell.Value & " already used as a sheet name"
    End If
    On Error GoTo 0
End With

End Sub

解决方案

Check to see if the worksheet exists before creating it:

Public Function WorkSheetExists(SheetName As String, wrkbk As Workbook) As Boolean
    Dim wrkSht As Worksheet
    On Error Resume Next
        Set wrkSht = wrkbk.Worksheets(SheetName) 'Attempt to set reference to worksheet.
        WorkSheetExists = (Err.Number = 0) 'Was an error generated - True or False?
        Set wrkSht = Nothing
    On Error GoTo 0
End Function

Then in your code just check if it exists before creating it:

Sub AddSheets()
    Dim cell As Excel.Range
    Dim wbToAddSheetsTo As Excel.Workbook

    Set wbToAddSheetsTo = ActiveWorkbook
    For Each cell In Selection
        **If Not (WorkSheetExists(cell.Value, wbToAddSheetsTo)) Then**
            With wbToAddSheetsTo
                .Sheets.Add after:=.Sheets(.Sheets.Count)
                On Error Resume Next
                ActiveSheet.Name = cell.Value
                If Err.Number = 1004 Then
                  Debug.Print cell.Value & " already used as a sheet name"
                End If
                On Error GoTo 0
            End With
        **End If**
    Next cell

End Sub

这篇关于宏可以创建基于列表的名称的新工作表，但如果重复不创建的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！