Excel：VBA创建没有重复的工作表

Question

我一直在尝试创建用于创建工作表的宏。 该代码应执行以下操作：

1）使用“模板”工作表中的模板为母版表中的ColumnB创建工作表。

2）“母版”工作表中ColumnB的范围是可变的，但这是我第一次尝试使用excel-vba，而且我不知道如何设置可变范围。

3）根据ColumnB中每个单元格中的名称重命名每个工作表

3.1）ColumnB有重复的条目，但是我们只需要为重复的单元格创建1个工作表。 （删除重复项不是一种选择）

4）将工作表超链接到“主”表的“列B”中的单元格。

我遇到上述3.1点的问题。 以下是我发现最有用的东西：我们可以根据需要对其进行优化吗？

Sub CreateAndNameWorksheets()
    Dim c As Range

    Application.ScreenUpdating = False
        For Each c In Sheets("Master").Range("B5:B25000")
        Sheets("Template").Copy After:=Sheets(Sheets.Count)
        With c
            ActiveSheet.Name = .Value
            .Parent.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
                "'" & .Text & "'!A1", TextToDisplay:=.Text
        End With
    Next c
    Application.ScreenUpdating = True

End Sub

谢谢！

Answer 1

解决方案说明：
虽然SheetExists是解决上述问题的理想选择，但实际的解决方案要比这复杂得多
解：
Sub Duplicate_Template将帮助您做到这一点。 并且在需要执行相同操作时更容易调用它（我称此为“镜像功能”）。

Sub Duplicate_Template(TemplateToDuplicate As String, NameNewSheet As String)
    If SheetExists(NameNewSheet) = False Then
    Sheets(TemplateToDuplicate).Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = NameNewSheet
    End If
End Sub
 Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
    Dim sht As Worksheet
     If wb Is Nothing Then Set wb = ThisWorkbook
     On Error Resume Next
     Set sht = wb.Sheets(shtName)
     On Error GoTo 0
     SheetExists = Not sht Is Nothing
 End Function

Answer 2

创建非重复工作表的一组通用功能：

您可以使用B列中的Cell.Values作为要测试的字符串

Sub Test()
    Call CreateNonDupeWS("Test1")
    Call CreateNonDupeWS("Test2", "Test1")
    Call CreateNonDupeWS("Test3", "Test1")
    Call CreateNonDupeWS("Test1")
End Sub

Private Function CreateNonDupeWS(wsNew As String, Optional wsAfter As String) As Boolean
On Error GoTo ExitSub
    If IsMissing(wsAfter) Then wsAfter = Sheets(Sheets.Count).Name
    If Not WorkSheetExists(wsNew) Then Worksheets.Add().Name = wsNew
    If WorkSheetExists(wsAfter) Then Worksheets(wsNew).Move After:=Worksheets(wsAfter)
    CreateNonDupeWS = True
ExitSub:
End Function

Function WorkSheetExists(ByVal sName As String) As Boolean
   On Error Resume Next
   WorkSheetExists = Not ActiveWorkbook.Worksheets(sName) Is Nothing
End Function