生成行值对应的工作表（存在重复值）

Question

我有一个主要工作sheet (Install_Input) 其中 sheet 编号、测试部分和 material 由用户手动输入。

（下图：Install_Input ws 的插图：范围 A1:C8）

Sheet# |测试部分 | Material

.......1.....|........A........|.STEEL.|

.......2.....|........B.........|.PLASTIC.|

.......3.....|........C........|.钢.|

.......5.......|........G..........|.STEEL.|

.......2.....|.......F..........|.PLASTIC.|

.......2.....|........A........|.STEEL.|

.......5.......|........D........|.PLASTIC.|

我想在当前工作簿中生成与 Install_Input 中输入的 sheet 个数字相对应的 sheet。我编写的代码将为 MyRange 中的每个值生成一个新的 sheet，但是，我希望我的代码跳过生成已经存在的 sheets .我尝试使用 "On Error Resume Next" 和 "On Error GoTo 0" 命令来解决这个问题，但它们只是生成了未命名的 sheet 来补偿那些已经存在的。

Sub Consolidate_Sheets()
    Dim MyCell As Range
    Dim MyRange As Range
    Dim ws As Worksheet

    Set MyRange = Sheets("Install_Input").Range("A2")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))


    For Each MyCell In MyRange
        If Sheets(Sheets.Count).Name <> MyCell.Value Then
            'On Error Resume Next
            Sheets.Add After:=Sheets(Sheets.Count) 
            Sheets(Sheets.Count).Name = MyCell.Value 
            'On Error GoTo 0
        End If
    Next MyCell
End Sub

Answer 1

您可以实现一个 CheckSheet 函数，就像 this SO answer 中描述的那样，循环遍历所有现有的 sheet 并将每个 sheet 的名称与传递的名称进行比较-输入值。

Answer 2

您可以使用以下两个功能：

    Function getSheetWithDefault(name As String, Optional wb As Excel.Workbook) As Excel.Worksheet
        If wb Is Nothing Then
            Set wb = ThisWorkbook
        End If

        If Not sheetExists(name, wb) Then
            wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)).name = name
        End If

        Set getSheetWithDefault = wb.Sheets(name)
    End Function

    Function sheetExists(name As String, Optional wb As Excel.Workbook) As Boolean
        Dim sheet As Excel.Worksheet

        If wb Is Nothing Then
            Set wb = ThisWorkbook
        End If

        sheetExists = False
        For Each sheet In wb.Worksheets
            If sheet.name = name Then
                sheetExists = True
                Exit Function
            End If
        Next sheet
    End Function

要在您的代码中使用它：

    Sub Consolidate_Sheets()
        Dim MyCell As Range
        Dim MyRange As Range
        Dim ws As Worksheet

        Set MyRange = Sheets("Install_Input").Range("A2")
        Set MyRange = Range(MyRange, MyRange.End(xlDown))

        For Each MyCell In MyRange
            If Sheets(Sheets.Count).Name <> MyCell.Value Then
                'On Error Resume Next
                set ws = getSheetWithDefault(MyCell.Value)
                'On Error GoTo 0
            End If
        Next MyCell
    End Sub

生成行值对应的工作表（存在重复值）

Generate sheets corresponding to row values (duplicate values exist)

excel

error-handling

dynamically-generated

worksheet

vba