Переупорядочение столбцов в нескольких файлах Excel

Question

У меня есть более 100 файлов excel в расширении .xlsx, столбцы во всех файлах не в порядке, я хотел бы переупорядочить порядок столбцов в соответствии с моим шаблоном, и я бы хотел добавьте данные из всех файлов в один выходной файл.

Я пробовал решение по этой ссылке Rearranging Columns in Multiple Excel Files using VBA, и это не сработало.

Ниже приведены примеры файлов Заголовки для справки.

File1

Заголовок1, Заголовок 2, Heading3

File2

Заголовок 2, Заголовок1, Heading5, Heading7

Файл шаблона

Заголовок1, Заголовок 2, Heading3, Heading4, Heading5, Heading6, Heading7

Ожидаемый результат файла

FileName, Заголовок1, Заголовок 2, Heading3, Heading4, Heading5, Heading6, Heading7

Answer 1

Если предположить, что в каждом файле вы работаете на листе (1) это будет делать работу:

Option Explicit 
Sub ColumnMover() 

    Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer 
    Dim mDirs As String 
    Dim path As String 
    Dim OutFile As Variant, SrcFile As Variant 
    Dim MyObj As Object, MySource As Object, file As Variant 

    OutFile = ActiveWorkbook.Name 
     mDirs = "c:\" 'your path here with \ in the end 
     file = Dir(mDirs) 
     While (file <> "") 
      path = mDirs + file 
      Workbooks.Open (path) 
      SrcFile = ActiveWorkbook.Name 

      n = 2 
      While Workbooks(OutFile).Sheets(1).Cells(n, 1).Value <> "" 
       n = n + 1 
      Wend 

      i = 2 
      While (Workbooks(OutFile).Sheets(1).Cells(1, i).Value <> "") 
       k = n 
       j = 1 
       While Workbooks(SrcFile).Sheets(1).Cells(1, j).Value <> Workbooks(OutFile).Sheets(1).Cells(1, i).Value And _ 
         Workbooks(SrcFile).Sheets(1).Cells(1, j).Value <> "" 

        j = j + 1 
       Wend 

       If Workbooks(SrcFile).Sheets(1).Cells(1, j).Value = Workbooks(OutFile).Sheets(1).Cells(1, i).Value Then 

        m = 2 
        While Workbooks(SrcFile).Sheets(1).Cells(m, j).Value <> "" 

         Workbooks(OutFile).Sheets(1).Cells(k, 1).Value = path 
         Workbooks(OutFile).Sheets(1).Cells(k, i).Value = Workbooks(SrcFile).Sheets(1).Cells(m, j).Value 

         k = k + 1 
         m = m + 1 
        Wend 
       End If 

       i = i + 1 
      Wend 

      Workbooks(file).Close (False) 
      file = Dir 
     Wend 
End Sub 

EDIT:

Некоторые пояснения:

здесь файл шаблона и выходной файл тот же. Итак, сначала вы должны иметь XLSM со структурой на листе (1):

FileName, Заголовок1, Заголовок 2, Heading3, Heading4, Heading5, Heading6, Heading7

введите данный код в этот файл, и запустите его, когда выходной файл является активным листом.

Answer 2

Попробуйте ниже.

Sub Order_Columns() 
    Dim template_headers As Variant, header As Variant, current_header As Variant, cl As Range, col As Integer 

    template_headers = Array("Heading1", "Heading2", "Heading3", "Heading4", "Heading5") 

    For header = LBound(template_headers) To UBound(template_headers) 
     current_header = template_headers(header) 

     col = col + 1 
     Set cl = ActiveSheet.Rows(1).Find(What:=current_header, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 

     If Not cl Is Nothing Then 
      If Not cl.Column = col Then 
       Columns(cl.Column).Cut 
       Columns(col).Insert Shift:=xlToRight 
      End If 
     End If 
    Next header 
End Sub 

• Укажите нужный порядок заголовка в массиве
• Обратите внимание, что заголовки чувствительны к регистру, так, возможно, использовать LCase()?

Я останусь с вами, чтобы добавить код, чтобы закодировать ваши 100 + папки, чтобы сделать это, а затем поместите эти данные на свой мастер-лист!