将 CSV 合并到一张表中并删除标题

Question

我将一个文件夹中的所有 CSV 文件合并到一个 Excel 工作表中。

Sub MergeFiles_Click()

    Dim strSourcePath As String
    Dim strDestPath As String
    Dim strFile As String
    Dim strData As String
    Dim x As Variant
    Dim Cnt As Long
    Dim r As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
    
    strSourcePath = Sheet1.Range("G2").Value
    
    If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
    
    strFile = Dir(strSourcePath & "*.csv")
    
    Do While Len(strFile) > 0
        
        Cnt = Cnt + 1
        
        If Cnt = 1 Then
            r = 6
        Else
            r = Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If
        
        Open strSourcePath & strFile For Input As #1
        Do Until EOF(1)
            Line Input #1, strData
            x = Split(strData, ",")
            For c = 0 To UBound(x)
                Cells(r, c + 1).Value = Trim(x(c))
            Next c
            r = r + 1
        Loop
            
        Close #1

        strFile = Dir
    Loop
    
    Application.ScreenUpdating = True
    
    If Cnt = 0 Then _
        MsgBox "No CSV files were found...", vbExclamation

End Sub

这会将所有 CSV 文件合并到一张纸上，但每个 CSV 文件在顶部都有一个标题和其他信息，占 12 行。

我想为第一个 CSV 保留 12 行，但在放入 Excel 工作表之前将它们从其余文件中删除。

我希望文件显示为一个，而不是看起来像是文件被复制并粘贴到工作表上。

Answer 1

对现有代码的最简单更改是仅包含代码以仅在 Cnt 为 1 时复制前 12 行，否则忽略它们：

Sub MergeFiles_Click()

    Dim strSourcePath As String
    Dim strDestPath As String
    Dim strFile As String
    Dim strData As String
    Dim x As Variant
    Dim Cnt As Long
    Dim r As Long
    Dim c As Long
    Dim inputRow As Long

    Application.ScreenUpdating = False

    strSourcePath = Sheet1.Range("G2").Value

    If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"

    strFile = Dir(strSourcePath & "*.csv")

    Do While Len(strFile) > 0

        Cnt = Cnt + 1

        If Cnt = 1 Then
            r = 6
        Else
            r = Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If


        Open strSourcePath & strFile For Input As #1
        inputRow = 0
        Do Until EOF(1)
            Line Input #1, strData
            'Maintain a count of how many rows have been read
            inputRow = inputRow + 1
            'Only process rows if this is the first file, or if we have
            'already passed the 12th row
            If Cnt = 1 Or inputRow > 12 Then
                x = Split(strData, ",")
                For c = 0 To UBound(x)
                    Cells(r, c + 1).Value = Trim(x(c))
                Next c
                r = r + 1
            End If
        Loop

        Close #1

        strFile = Dir
    Loop

    Application.ScreenUpdating = True

    If Cnt = 0 Then _
        MsgBox "No CSV files were found...", vbExclamation

End Sub

Answer 2

正如 Yow E3K 所说，您第一次可以只复制前十二行。 我的偏好是先将它们放在模板上，然后再从不复制它们。

下面的代码（来自 VBA Copy data from an unopened CSV file to worksheet without opening closed CSV - 谢谢 Chancea）已在中途进行了修改，以便通过输入从第 2 行开始复制 .TextFileStartRow = 2

Sub ImportFromCSVWithoutHeaders()

Dim MyDocuments, strFileName, myToday, file, strConnection As String

MyDocuments = Environ$("USERPROFILE") & "\My Documents"
myToday = Format(Date, "mmddyy")
strFileName = "DataFile" & myToday & ".csv"

Dim row As Integer
row = 1
On Error Resume Next
row = Range("A1048576").End(xlUp).row + 1

strConnection = "TEXT;" & MyDocuments & "\DataFolder\" & strFileName

With ActiveSheet.QueryTables.Add(Connection:= _
     strConnection, Destination:=Range("$A$" & row))
    .Name = "temp"
    .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 = 1
    .TextFileStartRow = 2
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
End Sub