Question

我有大约900个CSV文件，所有这些文件都是从跟踪软件中导出的。不幸的是，该软件在具有许多标题的逐帧数据的顶部按行排列大约52行的摘要数据。

我正在寻找的方法是：

1）打开csv文件

2）将摘要数据保存为单独的电子表格，文件名为“Original_Summary”

3）将逐帧数据（包括标题）保存到单独的Excel文件中，原始文件名作为工作表的新名称。

以前，我已经用~124个文件为每个文件手动完成了这个剪切/粘贴，但由于文件数量已经失控，我不确定手动执行此操作是最佳选择。 / p>

我已经编写了另一个脚本，我将这些excel文件作为单独的表导入Access，但现在我需要一种方法从CSV中传输它们，顶部的所有额外摘要数据都移到一个单独的文件。

我有办法做到这一点吗？

谢谢！

Sub ImportManyTXTs_test()
Dim strFile As String
Dim foldername As String
Dim ws As Worksheet
strFile = Dir("C:\Users\Jared\Desktop\Processed\Text\*.txt")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
   "TEXT;" & "C:\Users\Jared\Desktop\Processed\Text\" & strFile, Destination:=Range("$A$1"))
    .Name = strFile
    '.FieldNames = True
    '.RowNumbers = False
    '.FillAdjacentFormulas = False
    '.PreserveFormatting = True
    '.RefreshOnFileOpen = False
    '.RefreshStyle = xlInsertDeleteCells
    '.SavePassword = False
    '.SaveData = True
    '.AdjustColumnWidth = True
    '.RefreshPeriod = 0
    '.TextFilePromptOnRefresh = False
    '.TextFilePlatform = 437
    '.TextFileStartRow = 52
    '.TextFileParseType = xlFixedWidth
    '.TextFileTextQualifier = xlTextQualifierDoubleQuote
    '.TextFileConsecutiveDelimiter = False
    '.TextFileTabDelimiter = False
    '.TextFileSemicolonDelimiter = False
    '.TextFileCommaDelimiter = False
    '.TextFileSpaceDelimiter = False
    '.TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1)
    '.TextFileFixedColumnWidths = Array(22, 13, 13)
    '.TextFileTrailingMinusNumbers = True
    '.Refresh BackgroundQuery:=False
    '.CommandType = 0
    '.Name = "T15_070916_B"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = 52
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False

End With
ActiveSheet.Name = strFile
strFile = Dir
Loop
End Sub

我已经尝试了这个，它似乎没有上传我的所有文件，只有前99个左右，它也不会将它们导入新的工作簿，而只是一个带有原始扩展名的新工作表。出于某种原因，它只能在我必须删除文件并重新开始之前工作一次。这很奇怪。

我仍然对编码很新，所以任何帮助都将不胜感激！

Answer 1

考虑SQL和QueryTable解决方案。使用ACE引擎（Windows .dll文件），您可以查询csv文件，特别是运行SELECT TOP 52 *以获取最高摘要行，然后对从第53行开始的底行使用QueryTable（因为ACE SQL没有{ {1}}谓词）。

下面设置了Top和Bottom部分的功能，使用宏创建工作簿和工作表，然后在循环中调用这些方法：

BOTTOM

Answer 2

感谢@Parfait，我能够开发出一些能够完成我想要它的代码。

  Sub ExtractCSV()
    Dim wb As Workbook
    Dim y As Workbook



    Dim strfile As String, strpath As String

'Adjust the line below to have the appropriate folder directory, changing from new folder to something

    strpath = "C:\Users\me\Desktop\Processed\Text\"
    strfile = Dir("C:\Users\me\Desktop\Processed\Text\*.txt")

    Do While strfile <> vbNullString

        Workbooks.OpenText Filename:=strpath & strfile, Origin:= _
        437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
        Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
        16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
        Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array( _
        29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), _
        Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array( _
        42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), _
        Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array(54, 1), Array( _
        55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), Array(61, 1), _
        Array(62, 1), Array(63, 1), Array(64, 1), Array(65, 1), Array(66, 1), Array(67, 1), Array( _
        68, 1), Array(69, 1), Array(70, 1), Array(71, 1), Array(72, 1), Array(73, 1), Array(74, 1), _
        Array(75, 1), Array(76, 1), Array(77, 1)), TrailingMinusNumbers:=True

        Set y = ActiveWorkbook

        'Adjust the line below to have the appropriate folder directory, changing from new folder to something

        ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\me\Desktop\New folder\todelete\" & strfile, FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False

        Set wb = Workbooks.Add()


        wb.Sheets(1).Name = Left(strfile, Len(strfile) - 4)
        wb.Sheets.Add After:=wb.Sheets(wb.Worksheets.Count)
        wb.Sheets(2).Name = Left(strfile, Len(strfile) - 4) & "_Original_Summary"


        y.Sheets(Left(strfile, Len(strfile) - 4)).Rows("1:51").Copy
        'y.Sheets(Left(strfile, Len(strfile) - 4)).Selection.Copy
        wb.Sheets(Left(strfile, Len(strfile) - 4) & "_Original_Summary").Range("A1").PasteSpecial
        y.Sheets(Left(strfile, Len(strfile) - 4)).Rows("52:1600").Copy
        'y.Sheets(Left(strfile, Len(strfile) - 4)).Selection.Copy
        wb.Sheets(Left(strfile, Len(strfile) - 4)).Range("A1").PasteSpecial
        y.Application.CutCopyMode = False
        y.Close True

        'Call TopSummary(wb, strpath, strfile)
        'Call BottomFrame(wb, strpath, strfile)

        'wb.SaveAs strpath & "\" & Replace(strfile, ".txt", ".xlsx"), xlWorkbookDefault
        wb.SaveAs Filename:="C:\Users\me\Desktop\New folder\" & Left(strfile, Len(strfile) - 4) & ".xlsx"

        wb.Close True

        strfile = Dir
    Loop

    Set wb = Nothing
End Sub

我唯一担心的是这可能会占用大量资源。希望它没有，但在我测试过的几个文件上，它有效！

使用excel或access中的规范自动将TXT文件导入xls

2 个答案: