VBA遍历文件夹内所有文件，核实表头（工作中同事表头不一致，不方便使用powerBi合并文件批量处理...）

 VBA遍历文件夹内所有文件，核实表头（工作中同事表头不一致，不方便使用powerBi合并文件批量处理...）

中间用到逻辑以及知识点：

1、选择文件框，获取文件路径

2、字符串处理，将字符串按\切片成数组，相当于从右向左删除文件名，获得文件所在文件夹路径，且最后保留"\"（至于这里为什么不直接选择文件夹而是选择文件，当时脑抽了/./）

3、忽略程序报错，核实是否存在某一个工作表sheet的名字，如果没有，则新建一个

F、遍历所有文件，打开，复制第一行

5、重新遍历所有文件，不过这次无须打开，直接取数组中的变量即可

Sub Verify_the_header()
    Dim MyFile As String, arr(1000) As String, count As Integer, k As Integer, wb As Workbook, wb_1 As Workbook, brr(1000) As String, book_name As String, str As String
    k = 1
    count = 1
    Set wb = ThisWorkbook
    '选择单个文件对话框，通过对话框选择文件
    With Application.FileDialog(msoFileDialogFilePicker)
        .title = "请先选择文件夹里面的任一文件，用于路径确认"                        '选择窗口的标题
        .InitialFileName = "D:\user\用于路径确认.txt" '初次打开窗口的路径以及默认名称
        .AllowMultiSelect = False                       '是否允许选择多个文件
        .Filters.Clear                                  '清除现有规则
        .Filters.Add "Text File", "*.txt"               '增加规则
        .Filters.Add "EXCEL File", "*.xlsx; *.xls", 1   '增加规则到第一位
        .Filters.Add "All File", "*.*", 1               '增加规则到第一位
        If .Show Then                                   '显示文件选择对话框
            .ButtonName = "Select Me"
            Set ipath = .SelectedItems                  '获取选择项,无论是否选择一项还是多项，返回的选项都是多项
        End If
    End With
    
    If IsEmpty(ipath) Then Exit Sub     '如果按取消键，退出
    ipath = ipath(1)                    '获取第一项选择
    Debug.Print ipath                '输出选择文件名
    crr = Split(ipath, "\")
    str = crr(UBound(crr))
    book_name = Replace(ipath, str, "")
    Debug.Print (book_name)
    
    
    MyFile = Dir(book_name & "*.xlsx")
    arr(count) = MyFile
    Do While MyFile <> ""
        MyFile = Dir
        If MyFile = "" Then
            Exit Do
        End If
        count = count + 1
        arr(count) = MyFile
    Loop
    '忽略报错
    On Error Resume Next
    '判断是否有表头核实这个sheet，如果没有则新建一个,如果有就什么都不做
    If (ThisWorkbook.Sheets("表头核实") Is Nothing) Then
        ThisWorkbook.Sheets.Add.Name = "表头核实"
    End If
    wb.Sheets("表头核实").Move before:=Sheets(1) '将表头移动到最前面
    wb.Sheets("表头核实").Range("a1:cc1000000").Clear
    For i = 1 To count
        Set wb_1 = Workbooks.Open(book_name & arr(i))
        wb_1.Sheets(1).Rows(1).Copy wb.Worksheets("表头核实").Rows(k)
        k = k + 1
        brr(i) = wb_1.Sheets(1).Name
        Debug.Print arr(i)
        ActiveWorkbook.Close savechanges = True '关闭打开的文件
    Next
    wb.Worksheets("表头核实").Activate
    Columns(1).Select
    Selection.Insert shift:=xlToRight
    Selection.Insert shift:=xlToRight
    Range("a1:a1").Select
    For i = 1 To count
        wb.Worksheets("表头核实").Cells(i, 1).FormulaR1C1 = arr(i)
        wb.Worksheets("表头核实").Cells(i, 2).FormulaR1C1 = brr(i)
    Next
End Sub