Question

我正在寻找一种基于单元格列表在Excel中创建工作表的方法我有问题是我希望脚本检查列表是否更新并添加其他工作表而不是重新创建或删除旧副本

1）是否可以从excel（非VBA）

2）如果不是我创建工作表的代码是：但如果我重新运行（并且我正在寻找更新），它将创建新的托管

Sub AddSheets()
'Updateby Extendoffice 20161215
    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook
    Application.ScreenUpdating = False
    For Each xRg In wSh.Range("A1:A7")
        With wBk
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xRg.Value
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " already used as a sheet name"
            End If
            On Error GoTo 0
        End With
    Next xRg
    Application.ScreenUpdating = True
End Sub

Answer 1

这是另一种选择。我还添加了一个部分，它将工作表命名为A列值。（如果需要，您可以删除它）。

Sub AddSheets()
'Updateby Extendoffice 20161215
Dim xRg     As Excel.Range
Dim wSh     As Excel.Worksheet
Dim wBk     As Excel.Workbook
Set wSh = ActiveSheet
Set wBk = ActiveWorkbook
Application.ScreenUpdating = False
For Each xRg In wSh.Range("A1:A7")
    With wBk
        If Not sheetExists(xRg.Value) and xRg <> "" Then
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            ActiveSheet.Name = xRg.Value
        End If
    End With
Next xRg
Application.ScreenUpdating = True
End Sub


Function sheetExists(sheetToFind As String) As Boolean
'http://stackoverflow.com/a/6040454/4650297
Dim sheet As Worksheet
sheetExists = False
For Each sheet In Worksheets
    If sheetToFind = sheet.Name Then
        sheetExists = True
        Exit Function
    End If
Next sheet
End Function

Answer 2

使用此功能检查工作表是否已存在，然后让它跳过它。

Function WorksheetExists(sName As String) As Boolean
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function

所以你的代码可以是：

Sub AddSheets()
    'Updateby Extendoffice 20161215
    Dim xRg As Variant
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook
    Application.ScreenUpdating = False
    For Each xRg In wSh.Range("A1:A7")
        If Not IsError(xRg) Then
            If xRg <> "" Then
                If Not WorkSheetExists((xRg)) Then
                    With wBk
                       .Sheets.Add after:=.Sheets(.Sheets.Count)
                        ActiveSheet.Name = xRg.Value
                    End With
                End If
            End If
        End If
    Next xRg
    Application.ScreenUpdating = True
End Sub

Function WorksheetExists(sName As String) As Boolean
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function

excel表创建和更新

2 个答案: