合并和过滤多个 CSV 文件 Excel VBA

Question

使用 Excel VBA 代码我想合并多个 CSV 文件（; 分隔）并根据一列 'Résultat' 过滤它们。到目前为止，我可以在一个文件夹中读取并循环遍历所有文件。但是我的最终文件（所有内容都应该合并，ThisWorkbook.Sheets(1)）最后是空的：

Dim NameFull As String
Dim NameB As String
 folder_path = "C:\blabla"
 my_file = Dir(folder_path & "*.csv")

 Do While my_file <> vbNullString


 Set target_workbook = Workbooks.Open(folder_path & my_file)
    
    
    RowsInFile = target_workbook.Sheets(1).UsedRange.Rows.Count
    NumOfColumns = target_workbook.Sheets(1).UsedRange.Columns.Count
    
    LastRow = ThisSheet.Cells(Rows.Count, "A").End(xlUp).Row
    
    'target_workbook.Worksheets(1).Range("A1").CurrentRegion.Copy data_sheet.Cells(LastRow + 1, "A")
    Set RangeToCopy = target_workbook.Sheets(1).Range(target_workbook.Sheets(1).Cells(RowsInFile, 1), target_workbook.Sheets(1).Cells(RowsInFile, NumOfColumns))
    
     'Range("F1").Copy Destination:=Cells(last_row + 1, "A")
    RangeToCopy.Copy Destination:=ThisWorkbook.Sheets(1).Cells(LastRow + 1, "A")
    target_workbook.Close False
    
    Set target_workbook = Nothing
    
    my_file = Dir()
Loop

我需要将最终合并的文件保存在 csv 中（; 分隔文件格式：=xlCSV，本地：=True）
PS : 是否可以只复制一列过滤的特定行？

Answer 1

根据需要修改常量。合并的行已保存到新工作簿。

更新 1 如果 space 不足以粘贴记录，请添加新的 sheet。

Option Explicit

Sub MergeCSVtoXLS()

    Const FOLDER = "C:\temp\so\csv\"
    Const FILTER_COL = 1 ' Résultat
    Const FILTER_CRITERIA = ">99"
    
    Dim wb As Workbook, wbCSV As Workbook
    Dim ws As Worksheet, wsCSV As Worksheet
    Dim CSVfile As String, XLSfile As String, LogFile As String
    Dim rng As Range, rngCopy As Range, a
    Dim TargetRow As Long, RowCount As Long
    Dim n As Long, r As Long, i As Long
    
    ' open new workbook for merged results
    Set wb = Workbooks.Add
    Set ws = wb.Sheets(1)
    TargetRow = 1
    i = 1 ' sheet no

    Application.ScreenUpdating = False
    
    ' log file
    LogFile = FOLDER & Format(Now, "yyyymmdd_hhmmss") & ".log"
    Open LogFile For Output As #1
    Print #1, "Folder", FOLDER
    Print #1, "Time", "n", "CSV File", "Rows", "Target Sht", "Target Row"

    ' csv files
    CSVfile = Dir(FOLDER & "*.csv")
    Do While Len(CSVfile) > 0
        n = n + 1
        Set wbCSV = Workbooks.Open(FOLDER & CSVfile, ReadOnly:=True, Local:=True)
        Set wsCSV = wbCSV.Sheets(1)
        Set rng = wsCSV.UsedRange

        ' filter and ropy
        rng.AutoFilter Field:=FILTER_COL, Criteria1:=FILTER_CRITERIA
        Set rngCopy = rng.Cells.SpecialCells(xlVisible)
        
        ' count rows to paste in each non-contig area
        RowCount = 0 '
        For Each a In rngCopy.Areas
            RowCount = RowCount + a.Rows.Count
        Next
        r = r + RowCount - 1
               
        ' check space available on sheet
        If TargetRow + RowCount > ws.Rows.Count Then
             wb.Sheets.Add after:=wb.Sheets(i)
             i = i + 1
             Set ws = wb.Sheets(i)
             TargetRow = 1
        End If
        ' log file
        Print #1, Time, n, CSVfile, RowCount, i, TargetRow

       ' copy paste values
        rngCopy.Copy
        ws.Cells(TargetRow, 1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        wbCSV.Close savechanges:=False

        ' remove header unless first file
        If TargetRow > 1 Then
            ws.Rows(TargetRow).Delete ' header
        End If
        TargetRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
        ' next file
        CSVfile = Dir()
    Loop
    Close #1
    Application.ScreenUpdating = True
    

    ' save merged file
    XLSfile = FOLDER & Format(Now, "yyyymmdd_hhmmss") & "_Merged.xls"
    wb.SaveAs XLSfile, FileFormat:=xlExcel8, Local:=True ' .xls Excel 97-2003 Workbook
    wb.Close savechanges:=False

    MsgBox n & " Files scanned " & r & " Rows added to " & i & " Sheets" & vbLf _
           & " Saved to " & XLSfile, vbInformation, "See log " & LogFile
 
End Sub

合并和过滤多个 CSV 文件 Excel VBA

Merge and filter Multiple CSV files Excel VBA

csv

excel

merge

vba