Question

我有一个主工作表（Install_Input），用户手动输入工作表编号，测试部分和材料。

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

表＃| TestSection |材料

..... ..... 1 | ..........甲.......... | .STEEL |

..... ..... 2 | ..........乙.......... |。塑料|

..... ..... 3 | ..........Ç.......... | .STEEL |

..... ..... 5 | ..........ģ.......... | .STEEL |

..... ..... 2 | ..........˚F.......... |。塑料|

..... ..... 2 | ..........甲.......... | .STEEL |

..... ..... 5 | .......... d .......... |。塑料|

我想在当前工作簿中生成与Install_Input中输入的工作表编号相对应的工作表。我制作的代码将为MyRange中的每个值生成一个新工作表，但是，我希望我的代码跳过生成已存在的工作表。我尝试使用“On Error Resume Next”和“On Error GoTo 0”命令来解决此问题，但他们只是生成了未命名的工作表以补偿已存在的工作表。

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中描述的功能，循环遍历所有现有工作表，并将每个工作表的名称与传入的值进行比较。

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

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

2 个答案: