问如何添加代码以自动删除多余的工作表？
EN

Stack Overflow用户

提问于 2021-01-14 13:31:21

回答 2查看 39关注 0票数 0

在@clomee的帮助下，非常感谢，我现在有这个代码。它允许我在单元格中输入一个特定的数字，它会复制我的模板窗口工作表，这样我就可以为每个工作表中的每一个输入单独的尺寸和规格。

下面的代码允许我输入6no，通过稍后将其更改为8，它将只复制模板2倍，而不是添加8个额外的副本。

我需要以某种方式给它添加另一个函数，所以如果我将单元格中的"8“替换为5，它将向后计数，并删除名称中数字>5的所有工作表。

这可能是简单的代码，但多亏了我在这里得到的帮助和答案，我才能走到这一步，并简化了我一开始的工作。

非常感谢!

Private Sub Worksheet_Change(ByVal target As Excel.Range)
    If target.Cells.Count = 0 Then Exit Sub
    If IsNumeric(target) And target.Address = "$B$4" Then
        Select Case target.Value
            Case 1 To 50: copierW
            End Select
            End If
End Sub
Sub copierW()
Dim sh1 As Worksheet, sh2 As Worksheet, sh As Worksheet, x As Integer
Set sh1 = Sheets("Main")
Set sh2 = Sheets("W-Template")
Set wh = Sheets("Reference")
x = ActiveSheet.Range("b4")
Count = 0
    For Each sh In Worksheets
        If Left(sh.Name, 1) = "W" And Right(sh.Name, 1) = "." Then
            Count = Count + 1
        End If
    Next sh
needed_copies = x - Count
    For numtimes = 1 To needed_copies
        ActiveWorkbook.Sheets("W-Template").Copy _
        After:=ActiveWorkbook.Sheets("Main")
        Count2 = Count + numtimes
        ActiveSheet.Name = "W" & Count2 & "."
    Next
Worksheets(1).Select
End Sub`

excel

vba

人脸识别特惠活动

精准实时的人脸检测、分析、识别等服务，在线、离线满足多样需求，可应用于智慧零售、智慧社区、在线娱乐等多种应用场景

回答 2

Stack Overflow用户

回答已采纳

发布于 2021-01-14 14:04:27

下面的代码删除所有在"W“之后包含更高数字作为x值的纸张。

Sub copierW()
Dim sh1 As Worksheet, sh2 As Worksheet, sh As Worksheet, x As Integer
Set sh1 = ThisWorkbook.Worksheets("Main")
Set sh2 = ThisWorkbook.Worksheets("W-Template")
Set wh = Sheets("Reference")
x = sh1.Cells(4, 2).Value
count = 0
    For Each sh In Worksheets
        If Left(sh.Name, 1) = "W" And Right(sh.Name, 1) = "." Then
            count = count + 1
        End If
    Next sh
needed_copies = x - count
If needed_copies < 0 Then
    For Each sh In Worksheets
        If Left(sh.Name, 1) = "W" And Right(sh.Name, 1) = "." And x < Left(Right(sh.Name, Len(sh.Name) - 1), Len(sh.Name) - 2) Then
            Application.DisplayAlerts = False
            ThisWorkbook.Worksheets(sh.Name).Delete
            Application.DisplayAlerts = True
        End If
    Next sh
Else
    For numtimes = 1 To needed_copies
        ActiveWorkbook.Sheets("W-Template").Copy _
        After:=ActiveWorkbook.Sheets("Main")
        Count2 = count + numtimes
        ActiveSheet.Name = "W" & Count2 & "."
    Next
End If
Worksheets(1).Select
End Sub

票数 0

Stack Overflow用户

发布于 2021-01-14 14:02:34

这应该可以做你想要的事情。

我声明了未声明的变量，并将x更改为long (不要使用整数)。

Option Explicit

Private Sub Worksheet_Change(ByVal target As Excel.Range)
    If target.Cells.count = 0 Then Exit Sub
    If IsNumeric(target) And target.Address = "$B$4" Then
        Select Case target.Value
            Case 1 To 50: copierW
            End Select
            End If
End Sub
Sub copierW()
Dim sh1 As Worksheet, sh2 As Worksheet, sh As Worksheet, wh As Worksheet, x As Long
Dim count As Long, needed_copies As Long, numtimes As Long, count2 As Long
Set sh1 = Sheets("Main")
Set sh2 = Sheets("W-Template")
Set wh = Sheets("Reference")
x = ActiveSheet.Range("b4")
count = 0
    For Each sh In Worksheets
        If Left(sh.Name, 1) = "W" And Right(sh.Name, 1) = "." Then
            count = count + 1
        End If
    Next sh
needed_copies = x - count
    If needed_copies < 0 Then
        Application.DisplayAlerts = False
        For Each sh In Worksheets
            If Left(sh.Name, 1) = "W" And Right(sh.Name, 1) = "." Then
                If Mid(sh.Name, 2, Len(sh.Name) - 1) > x Then
                    sh.Delete
                End If
            End If
        Next sh
        Application.DisplayAlerts = True
    Else
        For numtimes = 1 To needed_copies
            ActiveWorkbook.Sheets("W-Template").Copy _
            After:=ActiveWorkbook.Sheets("Main")
            count2 = count + numtimes
            ActiveSheet.Name = "W" & count2 & "."
        Next
    End If
Worksheets(1).Select
End Sub