Question

我在堆栈上进行了研究，但无法找到我需要的内容或足够近以编辑代码。我对VBA很新。

我在目录中有一堆（> 100个文件）的.csv文件。文件名与以下格式一致：customer_id-inventory_id.forecast.csv。

例如：12345678-111111.forecast.csv; 12345-222.forecast.csv; ......等等。

这些文件只有两列，包含日期和预测。我想将文件名中的customer_id和inventory_id引入每个文件的这些单元格中。请参阅原始文件：

12345678-111111.forecast.csv;

12345-222.forecast.csv;

引入customer_id和inventory_d后输出文件。我如何在VBA中写这个？谢谢！

12345678-111111.forecast.csv;

12345-222.forecast.csv;

我试过了：VBA - Excel Append Every Active Row With File Name

Dim LastRow As Long
Dim LastColumn As Long
Sub InsertFileName()
  Application.ScreenUpdating = False
  Dim i As Long
  LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
  For i = 1 To LastRow
    LastColumn = ActiveSheet.Cells(i,     ActiveSheet.Columns.Count).End(xlToLeft).Column
    ActiveSheet.Cells(i, LastColumn + 1) = "=CELL(""filename"")"
  Next i
  Application.ScreenUpdating = True
End Sub

这不会生成任何文件名。

Answer 1

这假定工作簿与所有CSV位于同一目录中。

Sub Consolidate()

    Dim sSQL        As String       'SQL String
    Dim oCn         As Object       'Connection
    Dim oRs         As Object       'Recordset
    Dim vFile       As Variant      'File Name
    Dim sCustomer   As String       'Customer ID
    Dim sItem       As String       'Inventory Item ID

'   Get filenames
    vFile = Dir(ThisWorkbook.Path & "\*.csv")

'   Create SQL
    While vFile <> vbNullString
        If sSQL <> vbNullString Then sSQL = sSQL & vbCr & "Union " & vbCr
        sCustomer = Split(vFile, "-")(0)
        sItem = Split(Split(vFile, "-")(1), ".")(0)
        sSQL = sSQL & "Select '" & sCustomer & "' as Customer, '" & sItem & "' as Item, * from [" & vFile & "]"
        vFile = Dir
        DoEvents
    Wend
'   Create Connection Objects
    Set oCn = CreateObject("ADODB.Connection")
    Set oRs = CreateObject("ADODB.Recordset")

    oCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & ThisWorkbook.Path & ";" & _
            "Extended Properties=""Text;HDR=YES;FMT = CSVDelimited"";"
    oRs.Open sSQL, oCn
    Debug.Print sSQL

    If Sheet1.ListObjects.Count > 0 Then Sheet1.ListObjects(1).Delete
    Sheet1.ListObjects.Add( _
        SourceType:=xlSrcQuery, _
        Source:=oRs, _
        Destination:=Sheet1.Range("C6")).QueryTable.Refresh

    oRs.Close
    oCn.Close

    Set oRs = Nothing
    Set oCn = Nothing

End Sub

Answer 2

注意：在运行此宏之前，您应该创建csv文件的备份，以防出现问题。那么也许这段代码可以帮助你：

Option Explicit

Sub LoopCsvFiles()

    Dim wb As Workbook
    Dim ws_name As String
    Dim file As Variant
    Dim aux_var As Variant

    ' Disabling alerts and screen updates
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ' csv_folder that contains your csv files 
    file = Dir("C:\csv_folder\")
    While (file <> "")
        If InStr(file, ".csv") > 0 Then

            ' Obtaining the first part of the filename
            aux_var = Split(file, ".")
            ' Obtaining the customer_id and the inventory_id
            aux_var = Split(aux_var(0), "-")

            ' Setting the workbook and sheetname
            Set wb = Workbooks.Open(file)
            ws_name = Replace(file, ".csv", "")

            ' Writting data
            wb.Worksheets(ws_name).Range("C1") = "customer_id"
            wb.Worksheets(ws_name).Range("C2") = aux_var(0)
            wb.Worksheets(ws_name).Range("D1") = "inventory_id"
            wb.Worksheets(ws_name).Range("D2") = aux_var(1)

            ' Exiting
            wb.Save
            wb.Close

        End If
        file = Dir
    Wend

    ' Restoring alerts and screen updates
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Done!"

End Sub

HTH;）

VBA将文件名中的行添加到单元格中

2 个答案: