1

需要从folder1 中读取多个CSV 文件（例如file1、file2..），并将这些文件中的每一个作为单独的工作表写入目标excel 中。此外，从文件夹 2 中读取类似的 CSV 文件（例如 file1、file2..），并将每个 csv 文件写入现有工作表中的上述 excel。

**** 资源 ****

文件夹1：

文件1：

col1, col2, col3
A, B, C
1, 2, 3

文件2：

col1, col2, col3
U, V, W
4, 5, 6

文件夹2：

文件1：

col1, col2, col3
D, E, F
1, 2, 3

文件2：

col1, col2, col3
X, Y, Z
4, 5, 6

**** 目标 ****

电子表格：

表 1（文件 1）：

col1, col2, col3 col1, col2, col3 
A, B, C, D, E, F
1, 2, 3, 4, 5, 6

表 2（文件 2）：

col1, col2, col3 col1, col2, col3
U, V, W, X, Y, Z
4, 5, 6, 4, 5, 6

代码：

Private Sub Workbook_Open()
   Call OpenCSVFile
End Sub

Sub OpenCSVFile()

    Dim prevRunFolderPath As String
    Dim destFolderPath As String
    Dim prevFileName As String
    Dim destFileName As String
    Dim row_count As Integer
    Dim comp_count As Integer
    Dim lineFromFile As String
    Dim lineItems() As String
    Dim wb As Workbook
    Dim prevVer As String
    Dim currVer As String
    Dim fileExtn As String

    prevRunFolderPath = "X:\"
    currRunFolderPath = "Y:\"
    destFolderPath = "Z:\"

    prevFileName = "file1.CSV"
    currFileName = "file2.CSV"

    destFileName = "Compare.xlsx"
    fileExtn = "*.CSV*"


    ' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
    Open prevRunFolderPath & prevFileName For Input As #1
    Open currRunFolderPath & currFileName For Input As #2

    Set wb = Workbooks.Add
    '    Workbooks.Add.SaveAs Filename:=destFolderPath & destFileName
    wb.SaveAs Filename:=destFolderPath & destFileName

    'ObjExcel.Add.SaveAs Filename:=destFolderPath & destFileName
    'Workbooks(destFolderPath & destFileName).Activate
    'ActiveWorkbook.Worksheets.Add.Name = "Test"

    row_count = 1
    prevVer = "Prev-Ver"
    currVer = "Curr-Ver"

'*** Below sets the column headers ****

    wb.Worksheets("Sheet1").Range("A" & row_count).Value = prevVer & "-Desc"
    wb.Worksheets("Sheet1").Range("B" & row_count).Value = prevVer & "-Scenario"
    wb.Worksheets("Sheet1").Range("C" & row_count).Value = prevVer & "-TC1"
    wb.Worksheets("Sheet1").Range("D" & row_count).Value = prevVer & "-TC2"
    wb.Worksheets("Sheet1").Range("E" & row_count).Value = prevVer & "-Status"

    wb.Worksheets("Sheet1").Range("F" & row_count).Value = currVer & "-Desc"
    wb.Worksheets("Sheet1").Range("G" & row_count).Value = currVer & "-Scenario"
    wb.Worksheets("Sheet1").Range("H" & row_count).Value = currVer & "-TC1"
    wb.Worksheets("Sheet1").Range("I" & row_count).Value = currVer & "-TC2"
    wb.Worksheets("Sheet1").Range("J" & row_count).Value = currVer & "-Status"

    wb.Worksheets("Sheet1").Range("K" & row_count).Value = "TC1-Comp"
    wb.Worksheets("Sheet1").Range("L" & row_count).Value = "TC2-Comp"
    wb.Worksheets("Sheet1").Range("M" & row_count).Value = "Status-Comp"

    row_count = 2

*** Below loops through file1 and write the data  to target excel ****    
    Do Until EOF(1)

        Line Input #1, lineFromFile

        'MsgBox "Line is" & LineFromFile

        lineItems = Split(lineFromFile, ",")

        wb.Worksheets("Sheet1").Range("A" & row_count).Value = lineItems(0)
        wb.Worksheets("Sheet1").Range("B" & row_count).Value = lineItems(1)
        wb.Worksheets("Sheet1").Range("C" & row_count).Value = lineItems(2)
        wb.Worksheets("Sheet1").Range("D" & row_count).Value = lineItems(3)
        wb.Worksheets("Sheet1").Range("E" & row_count).Value = lineItems(4)
        row_count = row_count + 1

        ' ActiveCell.Offset(row_number,
    Loop 'Until row_count > 4

    row_count = 2

'*** Below loops through file2 and write the data  to target excel **** 

    Do Until EOF(2)

        Line Input #2, lineFromFile

        'MsgBox "Line is" & LineFromFile

        lineItems = Split(lineFromFile, ",")


        wb.Worksheets("Sheet1").Range("F" & row_count).Value = lineItems(0)
        wb.Worksheets("Sheet1").Range("G" & row_count).Value = lineItems(1)
        wb.Worksheets("Sheet1").Range("H" & row_count).Value = lineItems(2)
        wb.Worksheets("Sheet1").Range("I" & row_count).Value = lineItems(3)
        wb.Worksheets("Sheet1").Range("J" & row_count).Value = lineItems(4)
        row_count = row_count + 1

        ' ActiveCell.Offset(row_number,
    Loop 'Until row_count > 4

    comp_count = 2

'*** Below does comparisions based on the data written to the target excel ***
    Do

        wb.Worksheets("Sheet1").Range("K" & comp_count).Value = "=C" & comp_count & "=H" & comp_count
        wb.Worksheets("Sheet1").Range("L" & comp_count).Value = "=D" & comp_count & "=I" & comp_count
        wb.Worksheets("Sheet1").Range("M" & comp_count).Value = "=E" & comp_count & "=J" & comp_count

        comp_count = comp_count + 1

        ' ActiveCell.Offset(row_number,
    Loop Until comp_count > row_count

   ' Close outFileName
    Close #1
    Close #2
    wb.Save
    wb.Close

End Sub

不确定如何为其余的 CSV 文件复制它，因为所有 CSV 文件内容都被写入单个工作表而不是单个工作表。

4

2 回答 2

0

假设您有 1 个包含多个 CSV 文件的文件夹，另一个文件夹包含相同数量的同名文件。所以你可以这样处理所有文件：

Dim folder1 as string, folder2 as string
Dim fname as string   ' current filename
Dim sh as Worksheet

Set wb = Workbooks.Add
If Err.Number <> 0 Then 
             ' handle error here
End If

wb.SaveAs Filename:=destFolderPath & destFileName
If Err.Number <> 0 Then 
        ' handle error here
End If

fname = Dir(folder1 & Application.PathSeparator & "*.csv")
If Err.Number <> 0 Then 
    ' handle error here
ElseIf fname = vbNullString Then
    ' no CSV file exists in folder 1
Else

    Do
        Open folder1 & Application.PathSeparator & fName For Input As #1
        If Err.Number <> 0 Then 
             ' handle error here
        End If
        Open folder2 & Application.PathSeparator & fName For Input As #2
        If Err.Number <> 0 Then 
             ' handle error here
        End If

     ' input files are open, add destination sheet
        Set sh = wb.Sheets.Add(after:=wb.Sheets(Sheets.Count)) ' add new sheet
        If Err.Number <> 0 Then 
             ' handle error here
        End If
        sh.Name = Split(fname, ".")(0)    ' rename sheet to name of current file w/o ".CSV"


  ' at this point you can fill dest file with header and data

  ' replace wb.Worksheets("Sheet1").Range("E" & row_count) kind of references with sh.Range("E" & row_count)

        Close #1
        Close #2

        fname = Dir   ' get next file from folder 1
     Loop Until sFile = vbNullString          ' until file exists
 End If

评论：

Err.Number在每个文件/工作簿/工作表操作之后检查是否成功是值得的。

新工作簿将具有默认的工作表数。使用上述算法，这些工作表将保持为空。所有添加的工作表都将具有源文件的名称。

sh.Cells(row_count, 5)在这种情况下，引用类型可能更方便，而不是sh.Range("E" & row_count)

于 2019-08-22T13:58:16.660 回答
0

这对我来说很好。

Sub CombineCsvFiles()
'updateby Extendoffice 20151015
    Dim xFilesToOpen As Variant
    Dim I As Integer
    Dim xWb As Workbook
    Dim xTempWb As Workbook
    Dim xDelimiter As String
    Dim xScreen As Boolean
    On Error GoTo ErrHandler
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xDelimiter = "|"
    xFilesToOpen = Application.GetOpenFilename("Text Files (*.csv), *.csv", , "Kutools for Excel", , True)
    If TypeName(xFilesToOpen) = "Boolean" Then
        MsgBox "No files were selected", , "Kutools for Excel"
        GoTo ExitHandler
    End If
    I = 1
    Set xTempWb = Workbooks.Open(xFilesToOpen(I))
    xTempWb.Sheets(1).Copy
    Set xWb = Application.ActiveWorkbook
    xTempWb.Close False
    Do While I < UBound(xFilesToOpen)
        I = I + 1
        Set xTempWb = Workbooks.Open(xFilesToOpen(I))
        xTempWb.Sheets(1).Move , xWb.Sheets(xWb.Sheets.Count)
    Loop
ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Kutools for Excel"
    Resume ExitHandler
End Sub
于 2019-09-13T13:29:12.637 回答