Блог

У меня есть несколько текстовых файлов, которые мне нужно объединить

У всех одинаковые заголовки (за исключением названия изображения, но оно будет меняться в порядке возрастания: «HU1284 — Позиция 2.Blind», «HU1284 — Позиция 3.Blind» и т.д.), Но разное количество строк информации в их наборе данных. Я использовал макрос Excel для их объединения, но для этого требуется разделение каждого файла в программе, которая генерирует текстовые файлы, и это занимает много времени. Я пытаюсь избежать этого, если это возможно. Кто-нибудь сможет помочь мне изменить приведенный ниже скрипт VBA, чтобы он мог объединять эти текстовые файлы как есть? Заранее спасибо!!

 Public HeadLine As String
Public ThisLine As String
Public Checkfilenum
Public TotalRows
Public NDresults

Sub Comb_1()
' Comb_1 Macro Used to combine the text files together into a sindle result file if new data results
' in going over the row limit then attempt will be made to make a new dresult file by incrementing index.
' will loop through until a valid dresults file can be made.

nbook = ActiveWorkbook.Name
'checkfor opened dresults workbook
wcnt = 0
For Each w In Workbooks
If UCase(w.Name) Like "DRESULT*" Then
wcnt = 1
w.Activate
End If
Next
If wcnt = 1 And HeadLine = "FirstOne" Then HeadLine = ThisLine
    
' CHeck if adding new file will exceed 65536 limit of Excel (may need to change for 2007)
Call MaxNumRowscheck(nbook, wcnt)
' If dresults file is not opened then create it from thie file (nbook)
If wcnt = 0 Then
    'Check if this is the first file in this run so we have line 6 to compare against.
    If HeadLine = "FirstOne" Then HeadLine = ThisLine
    On Error GoTo exitsub
    ' create dresults (note will check for existance of one just in case.)
    ActiveWorkbook.SaveAs Filename:="dresults.xlsm", FileFormat:=xlNormal
    Workbooks("dresults.xlsm").Activate
    ' prep sheet
    Sheets(1).Name = "Combined data"
    
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
        "_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)) _
        , TrailingMinusNumbers:=True
    Range("A3").Select
    Selection.TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
        :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Range("A4").Select
   
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    
    Range("G1:J1").Select
    Selection.Cut
    Range("A8").Select
    ActiveSheet.Paste
    Range("G3").Select
    Selection.Cut
    Range("E8").Select
    ActiveSheet.Paste
    
    Rows("1:6").Select
    Selection.Delete Shift:=xlUp
    
    Range("A2:E2").Select
    Selection.Copy
    
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FillDown
    
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 5).Range("A1").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, -1).Range("A1").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Exp_Round"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Within_Round_Pair"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Within_Pair_Imaged_Seq"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Image_Number"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Mask"
    
    Range("A1").Select
    
ElseIf ThisLine = HeadLine Then
    ' repeat work above but for files just being prepared and appended
    ' using the previously started dresults file