时间戳

首页 > 解决方案 > 从一列单元格创建新工作表，同时避免重复

excel - 从一列单元格创建新工作表，同时避免重复

问题描述

我有几列需要排序的长数据。在第一列中，我有工作表的名称。但是那里有几个重复项会给我一个错误消息，因为每张表都需要一个唯一的名称。第二列和所有其他列将分布在工作表中，但到目前为止这不是我担心的，因为我不能让第一部分不给我错误消息。它工作正常，直到它遇到重复的条目。

    Dim lastRow As Long
    Dim sheetname As Variant
    Dim sheetexists As Boolean
    Dim cellname As Variant
    Dim worksheet_count As Integer
       
    Dim mysheet As Worksheet
    
        'Find the last non-blank cell in column A1
        lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lastRow
        worksheet_count = ActiveWorkbook.Worksheets.Count
        sheetexists = False
        For j = 1 To worksheet_count
            sheetname = Cells(i, 1).Value
            cellname = Sheets(j).Name
            If cellname = sheetname Then
                sheetexists = True
                a = 5
                Exit For
            End If
        Next j
                
        If sheetexists = False Then
            'create sheet, rename sheet
                
            Worksheets(1).Select
            sheetname = Cells(i, 1).Value
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = sheetname
        End If
    Next i

标签： excelvba

解决方案

下面是一种不那么繁琐的方法来做你想做的事。
注意：假设工作表名称位于活动工作表第 1 列的第 2 行以上（根据您的代码）：

Sub CreateSheets()

    Dim lgErr&, rgRg As Range, rgShNames As Range
    
    Set rgShNames = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
    
    For Each rgRg In rgShNames.Cells
    
        If rgRg <> "" Then
            On Error Resume Next: Err.Clear
                With Sheets(rgRg.Value): End With
            lgErr = Err: On Error GoTo 0
            
            If lgErr <> 0 Then
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = rgRg
            End If
        End If
    
    Next rgRg

End Sub

推荐阅读