Question

我有一个包含多个csv文件的目录，我希望将数据添加到表中，还要引用csv文件和行

例如，如果我有2个csv文件

csv1

year;price
2016;£50
2017;£40

CSV2

year;price
2016;£20
2017;£10

我希望桌子看起来像这样：

File | Row | Year | Price
-------------------------
csv1 | 1   | 2016 | £50
csv1 | 2   | 2017 | £40
csv2 | 1   | 2016 | £20
csv2 | 2   | 2017 | £10

到目前为止，我可以添加数据，但我正在努力添加文件名和行，任何想法？

这是我到目前为止所拥有的

Sub Update_Data()
    '~>Define variables
    Dim fPath   As String:      fPath = "C:\Archive\"
    Dim csvFileName    As String

    '~>Start the CSV file listing
    csvFileName = Dir(fPath & "*.csv")

    Do While Len(csvFileName) > 0
        '~>Retrieve the data from the .csv file
        Call Append_CSV_Data(csvFileName)

        '~>Ready next CSV
        csvFileName = Dir
    Loop

End Sub

Sub Append_CSV_Data(csvFileName)
    Dim destCell As Range
    Dim qTable As QueryTable
    Dim wSheet As Worksheet

    Set destCell = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Offset(1)

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & csvFileName, Destination:=destCell)
        .TextFileStartRow = 2
        .TextFileParseType = xlDelimited
        .TextFileSemicolonDelimiter = True
        .Refresh BackgroundQuery:=False
    End With

    For Each wSheet In ThisWorkbook.Worksheets
        For Each qTable In wSheet.QueryTables
            qTable.Delete
        Next qTable
    Next wSheet
End Sub

Answer 1

也许添加一些代码

'get new last row
lastCell = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Offset(1)
'Input file name
Range(Cells(destCell.Row, 1), Cells(lastCell , 1)) = csvFileName
'input row
For i = 1 to lastCell - destCell.Row 
  Cells(destCell.Row + i - 1, 2) = i
Next i

在引入查询表之后但在结束子目录之前将其放入。

导入多个CSV文件并添加文件名和行

1 个答案: