04_筛选标记4.0版 文件夹批量操作(不可选文件数量)

1.遍历文件夹

Sub VBA小程序_遍历文件夹内所有文件_搜索相关内容()
    Dim myPath$, myFile$, myPath1$, myPath2$, WB As Workbook, new_book As Workbook, yes_no '这个$ 是相当于定义字符串
    
    '调用函数，获取用户选择的文件夹，并且在最后加上一个反斜杠，用于下面的文件列表获取
    myPath2 = ChooseFolder  '这里的路径是没有加入最后的"\"的
    myPath = myPath2 & "\"
    
    myPath1 = InStrRev(myPath2, "\") '从右向左查找"\"，返回其所在的位置，返回值是一个数字，但是最后会变成一个字符串，所以定义的时候也定义了一个字符串
    If myPath1 = 0 Then
        myPath1 = ""    '如果找不到"\"，那么就说明用户选择是主硬盘，如：C:\\等，这样就 返回空值
    Else
        myPath1 = Right(myPath2, Len(myPath2) - myPath1) & "_" '如果不是空值，那么就直接可以使用Right提取，使用最开始没有"\"的myPath2这个变量，
    End If
    
    myFile = Dir(myPath & "*.xls*") '依次找寻指定路径中的*.xls，或者xlsx文件
    
    Do While myFile <> "" '当指定路径中有文件时进行循环
        If myFile <> ThisWorkbook.Name Then     '如果我们这个宏文件在需要处理的文件夹之中，这个判断就会跳过下面的操作
            Set WB = Workbooks.Open(Filename:=myPath & myFile, UpdateLinks:=0) '打开符合要求的文件，并且如果遇到需要更新链接的时候，默认不更新
            Call 搜索确认
            WB.Close -1  '保存关闭文件 0代表FALSE,-1代表TRUE
        End If
        myFile = Dir '找寻下一个*.xls，或者xlsx文件
    Loop
    Set WB = Nothing    '释放变量内存
    MsgBox ("兄台，已完成")
End Sub

2.文件主程序

Public Function ChooseFolder() As String    '定义函数，用于下面的调用
    '定义并新建一个对话框对象
    Dim dlgOpen As FileDialog
    Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)
    '如果当前没有对话框显示，就让他弹出对话框
    If dlgOpen.Show = -1 Then ChooseFolder = dlgOpen.SelectedItems(1)
    Set dlgOpen = Nothing
End Function
Sub 搜索确认()
    Dim Town As String
    Dim wsh As Object
     
    Call 初始化  ' 初始化表格状态
      
    ' Town = InputBox("请输入街道名称!")  '街道输入
    Town = "测试"
    For Each wsh In Sheets     '表格循环
    
        wsh.Select
        Call 筛选(wsh, Town)
        Call 标记(wsh, Town)
        
    Next wsh

    Excel.Worksheets(1).Select

End Sub

3.筛选

Sub 筛选(ByRef wsh As Object, Town As String)
    If wsh.Range("G1").Value = "乡（镇、街道）" Then         'G列标题判定
         Call 筛选封装(wsh, "G1", 7, Town)
    ElseIf wsh.Range("F2").Value = "乡" Then     'F列标题判定-->相邻月和单月
        Call 筛选封装(wsh, "F2", 6, Town)
    Else:                                                       'I列标题判定
        Call 筛选封装(wsh, "I2", 9, Town)
    End If

End Sub

Sub 筛选封装(ByRef wsh As Object, rng As String, fld As Byte, Town As String)
    wsh.Range(rng).AutoFilter field:=fld, Criteria1:=Town
End Sub
Sub 标记(ByRef wsh As Object, Town)
        ' wsh.Activate
        Dim a
        Set a = Cells.Find(What:=Town)
        If Not a Is Nothing Then
            wsh.Tab.ColorIndex = 6
        Else
            Debug.Print (ActiveWorkbook.Name & ";" & wsh.Name & ";找不到")
        End If
End Sub

4.取消筛选标记

Sub 初始化() '取消筛选标记
    Dim wsh As Object
    
    For Each wsh In Sheets
        wsh.Tab.ColorIndex = -4142 '取消颜色标记,取消筛选，取消隐藏
        wsh.AutoFilterMode = False
        Cells.EntireRow.Hidden = False
        Cells.EntireColumn.Hidden = False
    Next wsh

End Sub