从范围值添加唯一表

Question

我正在尝试编写贯穿G列的代码，并为每个唯一值添加一个新工作表，而不创建重复项;然而，从我所拥有的，所以它创建重复

Public Sub AddSheet()
    Worksheets("Dataset").Select
    Range("A1", Range("A1").End(xlToRight)).Name = "Title"
    Range("A2", Range("G1").End(xlDown)).Name = "Data"
    Range("H2", Range("H1").End(xlDown)).Name = "Physician"
    Dim i As Integer, lastrow As Integer
    lastrow = Worksheets("Dataset").Cells(Worksheets("Dataset").Rows.Count, "H").End(xlUp).Row
    With Range("Physician")
        For i = 1 To lastrow
            If i.Value = Worksheetexists = False Then
                Sheet.Add
                ActiveSheet.Name = Worksheets("Dataset").Cells(i, 1).Value
            Else
                GoTo NextStep:
            End If
        Next
    End With

End Sub

Answer 1

这样的东西应该工作并且更安全一些，因为您可能需要检查您正在添加的工作表已经存在的边缘情况。我正在使用字典来跟踪唯一的工作表名称，然后根据列H中的唯一值添加到该字典。

Sub SOExample()
    Dim DataSheet   As Excel.Worksheet
    Dim ws          As Excel.Worksheet
    Dim lastRow     As Long
    Dim i           As Long
    Dim dict        As Object
    Dim SheetName   As String

    Set dict = CreateObject("Scripting.Dictionary")
    Set DataSheet = ThisWorkbook.Worksheets("Dataset")

    lastRow = DataSheet.Cells(DataSheet.Rows.Count, "H").End(xlUp).Row

    'Add existing sheets into the dictionary first
    'in case a sheet already exists with that name
    For Each ws In ThisWorkbook.Worksheets
        dict.Add ws.Name, ws.Name
    Next

    'Loop the range and add new sheets
    For i = 1 To lastRow
        SheetName = DataSheet.Cells(i, 8).Value 'Column H is index 8
        If Not dict.exists(SheetName) Then
            dict.Add SheetName, SheetName
            Set ws = ThisWorkbook.Worksheets.Add
            ws.Name = SheetName
        End If
    Next

End Sub