Vba 如何循环浏览Excel工作簿中的所有工作表并替换某些工作表

我正在用VBA for Excel编写宏。我希望它取代所有的工作表，除了少数。首先是一个循环，删除不需要的图纸，然后是另一个循环，它创建新图纸以重新绘制图纸！在第一次运行时，宏将删除不需要的图纸。但是，如果再次运行，它似乎无法删除以前创建的图纸，这会导致名称重复错误

（rng变量应该扩展到整行，但我还没有解决这个问题。） 希望你们能提供一些见解，非常感谢

sub Terminator() 
Dim Current As Worksheet
Application.DisplayAlerts = False
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
    If Not Current.Name = "Data" Then
        Worksheets(Current.Name).Delete
    End If
Next Current
Application.DisplayAlerts = True

' Define range for loop
Dim rng As Range, cell As Range
Set rng = Sheets("Data").Range("A5:M5")
' Loop through entire row, looking for employees
For Each cell In rng
    If cell.Value = "Nummer" Then
        ' Make new chart for employee
        With Charts.Add
            .ChartType = xlLineMarkers
            .Name = cell.Offset(-1, 1).Value
            .HasTitle = True
            .ChartTitle.Text = cell.Offset(-1, 1).Value
            ' Set data (dynamic) and x-axis (static) for new chart
            .SetSourceData Source:=Sheets("Data").Range(cell.Offset(-2, 3), cell.Offset(7, 4))
            .Axes(xlValue).MajorGridlines.Select
            .FullSeriesCollection(1).XValues = "=Data!E4:E12"
            ' Add trendlines
            .FullSeriesCollection(1).Trendlines.Add Type:=xlLinear, Forward _
            :=0, Backward:=0, DisplayEquation:=0, DisplayRSquared:=0, Name:= _
            "Trend (DDE)"
            .FullSeriesCollection(2).Trendlines.Add Type:=xlLinear, Forward _
            :=0, Backward:=0, DisplayEquation:=0, DisplayRSquared:=0, Name:= _
            "Trend (SDE)"
        End With
        ' Chart is moved to end of all sheets
        Sheets(cell.Offset(-1, 1).Value).Move _
         after:=Sheets(Sheets.Count)
    End If
Next cell
End Sub

---

无需使用

工作表（）定义工作表

无需使用
工作表（）定义工作表

下面的代码（在我的工作簿中进行了一些小更改），您确定您在工作簿中的If中有输入的名称吗？
无论如何，我认为最好对多个可能的数学使用Select

Sub Terminator()

    Dim Current                         As Excel.Worksheet

    Application.DisplayAlerts = False

    ' Loop through all of the worksheets in the active workbook.
    For Each Current In ActiveWorkbook.Sheets
        If Not (Current.Name = "Data") Then
            ActiveWorkbook.Worksheets(Current.Name).Delete
        End If
    Next Current
    Application.DisplayAlerts = True

End Sub

下面的代码（在我的工作簿中进行了一些小更改），您确定您在工作簿中的If中有输入的名称吗？
无论如何，我认为最好对多个可能的数学使用Select

Sub Terminator()

    Dim Current                         As Excel.Worksheet

    Application.DisplayAlerts = False

    ' Loop through all of the worksheets in the active workbook.
    For Each Current In ActiveWorkbook.Sheets
        If Not (Current.Name = "Data") Then
            ActiveWorkbook.Worksheets(Current.Name).Delete
        End If
    Next Current
    Application.DisplayAlerts = True

End Sub

RGA提供了删除的解决方案，但如果您希望避免对每个要保留的工作表使用多个AND语句，则可以使用类似于以下isInArray的功能：

Sub Terminator()

Dim Current As Variant

Application.DisplayAlerts = False
' Loop through all of the worksheets in the active workbook.
For Each Current In ThisWorkbook.Sheets
    If Not isInArray(Current.Name, Array("Data")) Then
        Current.Delete
    End If
Next
Application.DisplayAlerts = True
End Sub

Function isInArray(theValue As String, vArr As Variant) As Boolean
    Dim vVal As Variant

    isInArray = False
    For Each vVal In vArr
        If LCase(vVal) = LCase(theValue) Then
            isInArray = True
        End If
    Next

End Function

编辑：
函数，该函数以工作表名称作为参数，并返回该名称的工作表对象。如果名称为allready Take，则删除现有图纸并创建新图纸：

'example of use:
'set newWorksheet = doExist("This new Sheet")

Function doExist(strSheetName) As Worksheet
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim wsTest As Worksheet
    Dim nWs As Worksheet

    Set wsTest = Nothing
    On Error Resume Next
    'Set wsTest = wb.Worksheets(strSheetName) 'commented out in Edit of Edit
    Set wsTest = wb.Sheets(strSheetName) 'as a comment for one of the other threads reveal, the error could be the deletion of Worksheets, which would be a subgroup to Sheets of which graph sheets are no a part
    On Error GoTo 0

    If Not wsTest Is Nothing Then
        Application.DisplayAlerts = False
        wsTest.Delete
        Application.DisplayAlerts = True
    End If

    'Set doExist = wb.Worksheets.Add(after:=wb.Sheets(wb.Sheets.Count)) 'Edit of Edit, the later call to Charts.Add does this for you
    'doExist.Name = strSheetName 'Edit of Edit, no need to return anything

End Function

RGA提供了删除的解决方案，但如果您希望避免对每个要保留的工作表使用多个AND语句，则可以使用类似于以下isInArray的功能：

Sub Terminator()

Dim Current As Variant

Application.DisplayAlerts = False
' Loop through all of the worksheets in the active workbook.
For Each Current In ThisWorkbook.Sheets
    If Not isInArray(Current.Name, Array("Data")) Then
        Current.Delete
    End If
Next
Application.DisplayAlerts = True
End Sub

Function isInArray(theValue As String, vArr As Variant) As Boolean
    Dim vVal As Variant

    isInArray = False
    For Each vVal In vArr
        If LCase(vVal) = LCase(theValue) Then
            isInArray = True
        End If
    Next

End Function

编辑：
函数，该函数以工作表名称作为参数，并返回该名称的工作表对象。如果名称为allready Take，则删除现有图纸并创建新图纸：

'example of use:
'set newWorksheet = doExist("This new Sheet")

Function doExist(strSheetName) As Worksheet
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim wsTest As Worksheet
    Dim nWs As Worksheet

    Set wsTest = Nothing
    On Error Resume Next
    'Set wsTest = wb.Worksheets(strSheetName) 'commented out in Edit of Edit
    Set wsTest = wb.Sheets(strSheetName) 'as a comment for one of the other threads reveal, the error could be the deletion of Worksheets, which would be a subgroup to Sheets of which graph sheets are no a part
    On Error GoTo 0

    If Not wsTest Is Nothing Then
        Application.DisplayAlerts = False
        wsTest.Delete
        Application.DisplayAlerts = True
    End If

    'Set doExist = wb.Worksheets.Add(after:=wb.Sheets(wb.Sheets.Count)) 'Edit of Edit, the later call to Charts.Add does this for you
    'doExist.Name = strSheetName 'Edit of Edit, no need to return anything

End Function

谢谢你的回答！如果“youhavethenames”的意思是字符串“Data”应该与名称数据匹配，那么是的，名称是相同的。我第一次运行了代码，效果非常好，但第二次运行时，它不会删除在上一次运行中创建的工作表。这将引发名称重复错误。谢谢您的回答！如果“youhavethenames”的意思是字符串“Data”应该与名称数据匹配，那么是的，名称是相同的。我第一次运行了代码，效果非常好，但第二次运行时，它不会删除在上一次运行中创建的工作表。这将引发名称重复错误。感谢您的快速回答！我第一次运行了代码，效果非常好，但第二次运行时，它不会删除在上一次运行中创建的工作表。这会引发名称重复错误。@MGroth“上一次运行”是什么意思？这是在一个更大的宏中运行吗？嗯，是的，再往下创建一个新的表。我想在每次运行时替换工作表。@MGroth您是否可以编辑您的问题以添加此代码？如果我看不见，我也帮不上忙。我的猜测是我们需要在某处添加一个
DoEvents
调用来刷新工作簿数据，但我需要查看代码以了解其位置/是否正确necessary@MGroth现在看看你的代码，当你说第二遍不能删除它们时：你是手动重新运行这个宏还是被另一个宏多次调用？谢谢你的快速回答！我第一次运行了代码，效果非常好，但第二次运行时，它不会删除在上一次运行中创建的工作表。这会引发名称重复错误。@MGroth“上一次运行”是什么意思？这是在一个更大的宏中运行吗？嗯，是的，再往下创建一个新的表。我想在每次运行时替换工作表。@MGroth您是否可以编辑您的问题以添加此代码？如果我看不见，我也帮不上忙。我的猜测是我们需要在某处添加一个
DoEvents
调用来刷新工作簿数据，但我需要查看代码以了解其位置/是否正确necessary@MGroth现在看看你的代码，当你说第二遍不能删除它们时：你是手动重新运行这个宏还是被另一个宏多次调用？谢谢你的回答！阵列是一个非常好的解决方案，可以使代码更具可伸缩性！我第一次运行代码，效果非常好，在宏的下面，我创建了新的工作表来替换删除的工作表，第二次运行时，这些工作表没有被删除。我看到了您对RGA的评论。如果尝试将新工作表命名为与现有工作表相同的名称，例如“Data”，则必须发生此错误。如果是这种情况，我可以给你一个函数，我用自己的工作表创建。函数首先检查名称是否已在使用，如果已在使用，则在创建/命名新工作表之前删除现有工作表是的，这正是情况。非常感谢！它小到可以写评论或邮件吗？嗯，实际上看看你添加的代码，我认为你的问题不在于工作表的创建，而在于你添加的图表。由于该图表已正确准备就绪，因此您正在尝试将新图表命名为与该图表相同的名称。你可以让doExist用图表做同样的事情所以。。。我必须以某种方式“刷新”它才能再次使用图形名称？谢谢您的回答！阵列是一个非常好的解决方案，可以使代码更具可伸缩性！我第一次运行代码，效果非常好，在宏的下面，我创建了新的工作表来替换删除的工作表，第二次运行时，这些工作表没有被删除。我看到了您对RGA的评论。如果尝试将新工作表命名为与现有工作表相同的名称，例如“Data”，则必须发生此错误。如果是这种情况，我可以给你一个函数，我用自己的工作表创建。该函数首先检查名称是否已在使用，如果已在使用，则删除