Question

我在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

Answer 1

无需使用Worksheets()

定义工作表

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

Answer 2

以下代码（在我的工作簿中进行了细微更改），您确定在工作簿中的 If 中添加了名称吗？无论如何，我认为使用选择进行多项可能的算术会更好

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

Answer 3

删除的解决方案由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

编辑：将工作表名称作为参数的函数，并返回该名称的工作表对象。如果已经使用该名称，则删除现有工作表并创建一个新工作表：

'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

如何遍历所有并替换Excel工作簿中的某些工作表

3 个答案: