Question

我在excel中有一个客户端列表，并且我有可以使用该列表的代码并为列表中的每个客户创建一个新标签。

问题在于列表每月都会更改，因此我需要运行代码再次更新列表。

因此，基本上，代码需要运行并跳过现有选项卡，以重新创建其超链接，并仅创建列表中的新条目。

我不是程序员，但是我可以摆弄一些代码，以便有人请帮助我。

我到目前为止的代码：

Sub CreateAndNameWorksheets()
    Dim c As Range

    Application.ScreenUpdating = False
    For Each c In Sheets("List").Range("B1:B471")
        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列的工作表列表中具有多少行值，并对其进行循环，然后遍历您的工作表，查看是否已经存在（如果不存在）然后它将创建该工作表。

根据您最近的评论，我已经更新了答案，以更新列表中每个项目的链接：

Sub CreateAndNameWorksheets()
    Dim c As Range
    Dim ws As Worksheet: Set ws = Sheets("List")
    Dim sh As Worksheet
    Dim FoundSh As Boolean

    Application.ScreenUpdating = False
    LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    'get last row with data on Column B
    For Each c In ws.Range("B1:B" & LastRow) 'loop through row 1 to Last

        For Each sh In ThisWorkbook.Worksheets 'loop through Worksheets
            If c.Value = sh.Name Then
                FoundSh = True 'if it exists set flag as found
                With c
                    .Parent.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
                        "'" & .Text & "'!A1", TextToDisplay:=.Text
                End With
            End If
        Next sh

        If FoundSh = False Then 'if it wasn't found then create it
            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
        End If
        FoundSh = False 'reset flag for next loop
    Next c
    ws.Select
    Application.ScreenUpdating = True
End Sub

更新：

要在B列中添加新值时自动运行代码，只需将下面的代码放在工作表列表下：

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then 'if anything gets changed or added in Column B
    Dim c As Range
    Dim ws As Worksheet: Set ws = Sheets("List")
    Dim sh As Worksheet
    Dim FoundSh As Boolean

    Application.ScreenUpdating = False
    LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    'get last row with data on Column B
    For Each c In ws.Range("B1:B" & LastRow) 'loop through row 1 to Last

        For Each sh In ThisWorkbook.Worksheets 'loop through Worksheets
            If c.Value = sh.Name Then
                FoundSh = True 'if it exists set flag as found
                With c
                    .Parent.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
                        "'" & .Text & "'!A1", TextToDisplay:=.Text
                End With
            End If
        Next sh

        If FoundSh = False And c.Value <> "" Then 'if it wasn't found then create it
            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
        End If
        FoundSh = False 'reset flag for next loop
    Next c
    ws.Select
    Application.ScreenUpdating = True
End If
End Sub

Answer 2

因此，此代码将根据您的模板从列表中创建新的工作表，如果更新了列表，则删除不在列表中的工作表，并创建指向所有选项卡的超链接。非常感谢@Xabier的所有帮助

PersonsRoot.tsx

具有自动链接和可更新功能的Excel自动选项卡创建

2 个答案: