[英]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.