VBA常用小代码205：按指定条件批量删除Excel工作簿

1，

诸君晚上好，照例先握爪撒。

前段时间我们分享了一期小代码，作用是一键提取指定文件夹下文件名，不知道大家是否还有印象

今天我们分享的内容是按指定条件批量删除Excel工作簿，但在删之前，我们自然需要先知道相关文件夹内都有哪些工作簿？

对【常用小代码201】中的代码稍加修改，即可批量将工作簿的完整名称提取到当前工作表的A列。

代码如下：

---

Sub kjxgbooks()

    Dim p$, f$, k&

    With Application.FileDialog(msoFileDialogFolderPicker)

        .AllowMultiSelect = False

        If .Show Then p = .SelectedItems(1) Else: Exit Sub

    End With

    If Right(p, 1) <> '\' Then p = p & '\'

    [a:b].ClearContents

    k = 1

    [a1] = '目录'

    [b1] = '是否删除'

    f = Dir(p & '*.xls*')

    Do While f <> ''

        k = k 1

        Cells(k, 1) = p & f

        f = Dir

    Loop

End Sub

---

代码大部分的语句在201期已经注释说明过了，所以这里就没有注释。

2，

使用以上代码可以将指定文件夹内的工作簿名称提取到表格的A列，如下图所示。

之后在表格的B列，咱们可以通过排序、筛选、以及函数等方式，灵活快捷的对A列的工作簿名称判断是否需要删除，如需删除，在B列标注为“删除”。

最后通过以下代码对判断的结果进行删除操作：

---

Sub Delbooks()

    Dim r, i&

    r = [a1].CurrentRegion '数据区域装入数组r

    For i = 2 To UBound(r) '遍历数组r

        If r(i, 2) = '删除' Then Kill r(i, 1)

        '如果B列的值为删除，则杀死相关文件。

    Next

End Sub

---