Question

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

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

2）Master Sheet中ColumnB的范围是可变的，但这是我第一次使用excel-vba，我不知道如何设置变量范围。

3）根据ColumnB

中每个单元格中的名称重命名每个工作表

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

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

创建非重复工作表的一组通用函数：

您可以使用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

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

1 个答案: