excel - 如何从多个excel文件中删除多个工作表，名称为Sheet+number

Question

我有一个宏，我想对文件夹中的每个 excel 文件应用数据验证，保存并关闭它。但现在我发现这个宏将应用于第一个打开的工作表，而不是文件名为 Name.LastName 的工作表

这些文件中的多个文件都有类似的表格

• 表 1
• 表 2
• 表 3
• …</li>
• 姓名.姓氏

如何删除 Sheet1、2、3 或有多少张。并且只留下 Name.LastName

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
                 Columns("A:A").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
            End With
            xFileName = Dir
        Loop
    End If
End Sub

如果可以以某种方式在这里实现该代码会更好

标签： excelvba

Answer 1

您必须在活动工作簿上循环工作表。试试下面的。

Sub LoopThroughFiles()
Dim xFd As FileDialog, xFdItem As Variant, xFileName As String, CrntWbk As Workbook, Ws As Worksheet
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

If xFd.Show = -1 Then
    xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    xFileName = Dir(xFdItem & "*.xls*")
    Do While xFileName <> ""
        Set CrntWbk = Workbooks.Open(xFdItem & xFileName)
        With CrntWbk
            For Each Ws In CrntWbk.Worksheets
                If Ws.Name = "Name.LastName" Then
                    ' If Worksheet Name is "Name.LastName", it applies the validation
                    With WS.Columns("A:A").Validation
                        .Delete
                        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
                        :=xlBetween
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .ShowInput = True
                        .ShowError = True
                    End With
                Else
                    'Deletes other sheets
                    Application.DisplayAlerts = False
                    Ws.Delete
                    Application.DisplayAlerts = True
                End If
            Next Ws
            .Save
            .Close
        End With
        xFileName = Dir
    Loop
End If