简体   繁体   English

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

[英]Merge and filter Multiple CSV files Excel VBA

With Excel VBA Code I would like to merge multiple CSV files (; separated) and filter them according to one Column 'Résultat'.使用 Excel VBA 代码,我想合并多个 CSV 文件(;分隔)并根据一列“结果”过滤它们。 So far I can read inside a folder and loop through all files.到目前为止,我可以在文件夹中读取内容并遍历所有文件。 but my final file (where everything is suppose to be merged, ThisWorkbook.Sheets(1)) is empty at the end :但我的最终文件(假设所有内容都被合并,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

I need to save the final merged file in csv (; separated FileFormat:=xlCSV, Local:=True)我需要将最终合并的文件保存在 csv (; 分隔 FileFormat:=xlCSV, Local:=True)
PS : Is it possible to only copy specific lines filtering on one column ? PS:是否可以只复制一列上的特定行过滤?

Amend the constants as required.根据需要修改常量。 Merged rows saved to new workbook.合并的行保存到新工作簿。

Option Explicit

Sub MergeCSV()

    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, rng As Range
    Dim LastRow As Long, TargetRow As Long, n As Long, r As Long

    ' open new workbook for merged results
    Set wb = Workbooks.Add
    Set ws = wb.Sheets(1)
    TargetRow = 1

    Application.ScreenUpdating = False

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

        ' filter and ropy
        rng.AutoFilter Field:=FILTER_COL, Criteria1:=FILTER_CRITERIA
        rng.Cells.SpecialCells(xlVisible).Copy

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

        ' remove header unless first file
        If n > 1 Then
            ws.Rows(TargetRow).Delete ' header
        End If
        TargetRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1

        CSVfile = Dir()
       
    Loop
    Application.ScreenUpdating = True

    ' save merged file
    CSVfile = FOLDER & Format(Now, "yyyymmdd_hhmmss") & "_Merged.csv"
    wb.SaveAs CSVfile, FileFormat:=xlCSV, Local:=True
    wb.Close savechanges:=False

    r = TargetRow - LastRow - 1
    MsgBox n & " Files scanned " & r & " Rows added" & vbLf _
           & " Saved to " & CSVfile, vbInformation
 
End Sub

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM