Nhờ mọi người giúp đỡ file gộp log csv. Khi code chạy xong bị dừng ở những file log có tên "(INF RRT)CoasiaRRT_2023_0705 (2).csv" có () là dừng chạy không gộp được file tiếp theo nữa. Vì là log ở các máy khác nhau mà cùng ngày chạy .Nên mình phải để như "* (2).csv" mới không bị trùng tên. Mình tìm hiểu nhưng chưa tìm ra nguyên nhân và cũng không rành lắm về code. Code này mình copy trên mạng và mình đang để trong file "Merge File Csv".
Gộp file CSV thì dùng CMD, PowerShell rất nhanh rồi đó nhưng phải thêm code để loại bỏ dòng tiêu đề các file sau.
Trong VBA dùng Open freefile cũng rất nhanh (chưa chớp mắt kịp đã xong) và gộp CSV vô file CSV luôn cho gọn nhẹ chứ ghi dữ liệu xuống Excel làm nặng nề thêm.
Gộp file CSV thì dùng CMD, PowerShell rất nhanh rồi đó nhưng phải thêm code để loại bỏ dòng tiêu đề các file sau.
Trong VBA dùng Open freefile cũng rất nhanh (chưa chớp mắt kịp đã xong) và gộp CSV vô file CSV luôn cho gọn nhẹ chứ ghi dữ liệu xuống Excel làm nặng nề thêm.
Gộp tệp CSV thì sử dụng CMD, PowerShell rất nhanh rồi đó nhưng phải thêm mã để loại bỏ dòng tiêu đề của tệp sau.
Trong VBA dùng Open freefile rất nhanh (chưa chớp mắt đã xong) và khoảng thời gian CSV vô file CSV luôn gọn nhẹ chứ không phải ghi dữ liệu xuống Excel làm nặng thêm.
Dùng cách đọc file text: Open fileName For Input As #fileNo
Xem file đính kèm.
Rich (BB code):
Option Explicit
Sub GopFiles()
Dim FilesToOpen() As Variant, newFileName As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="CSV Files (*.csv), *.csv", MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
newFileName = ThisWorkbook.Path & "\MergedCSVFiles.csv"
MergeCSVFiles FilesToOpen, newFileName, True, False
MsgBox "Xong."
'Mo file
CreateObject("Shell.Application").Open (newFileName)
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
Sub MergeCSVFiles(fileNames() As Variant, newFileName As String, Optional headers As Boolean = True, Optional addNewLine As Boolean = False)
'# fileNames: Danh sách tên file - array
'# newFilename: Tên file moi sau khi merge
'# headers: Có lay dong tieu de hay không
'# addNewLine: Có thêm dòng moi cuoi file hay không
Dim fileName As Variant, textData As String, fileNo As Long, result As String, firstHeader As Boolean
firstHeader = True
For Each fileName In fileNames
fileNo = FreeFile
Open fileName For Input As #fileNo
textData = Input$(LOF(fileNo), fileNo) 'Doc toan bo File
Close #fileNo
If headers Then 'Có dòng tieu de
result = result & IIf(addNewLine, vbNewLine, "") & IIf(firstHeader, textData, Right(textData, Len(textData) - InStr(textData, vbNewLine)))
firstHeader = False 'Thiet lap false de khong lay header file 2,3...
Else
result = result & IIf(addNewLine, vbNewLine, "") & textData
End If
Next fileName
fileNo = FreeFile
Open newFileName For Output As #fileNo
Print #fileNo, result
Close #fileNo
End Sub
Dùng cách đọc file text: Open fileName For Input As #fileNo
Xem file đính kèm.
Rich (BB code):
Option Explicit
Sub GopFiles()
Dim FilesToOpen() As Variant, newFileName As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="CSV Files (*.csv), *.csv", MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
newFileName = ThisWorkbook.Path & "\MergedCSVFiles.csv"
MergeCSVFiles FilesToOpen, newFileName, True, False
MsgBox "Xong."
'Mo file
CreateObject("Shell.Application").Open (newFileName)
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
Trình xử lý lỗi:
MsgBox Err.Des mô tả
Tiếp tục thoát Trình xử lý
kết thúc phụ
Hợp nhất phụCSVFiles(fileNames() Dưới dạng biến thể, newFileName dưới dạng chuỗi, tiêu đề tùy chọn dưới dạng Boolean = True, tùy chọn addNewLine dưới dạng Boolean = False)
'# fileNames: Danh sách tên tệp - mảng
'# newFilename: Tên file mới sau khi gộp
'# headers: Có lay dong tieu de hay khong
'# addNewLine: Có thêm dòng mới cuối file hay không
Tên tệp mờ Dưới dạng biến thể, dữ liệu văn bản dưới dạng chuỗi, tệpKhông theo độ dài, kết quả dưới dạng chuỗi, tiêu đề đầu tiên dưới dạng Boolean
firstHeader = Đúng
Đối với mỗi tên tệp Trong tên tệp
fileNo = FreeFile
Mở tên tệp cho đầu vào dưới dạng #fileNo
textData = Input$(LOF(fileNo), fileNo) 'Doc toan bo File
Đóng #fileKhông
If headers Then 'Có dòng tieu de
kết quả = kết quả & IIf(addNewLine, vbNewLine, "") & IIf(firstHeader, textData, Right(textData, Len(textData) - InStr(textData, vbNewLine)))
firstHeader = False 'Thiết lập false de khong lay header file 2,3...
Khác
kết quả = kết quả & IIf(addNewLine, vbNewLine, "") & textData
kết thúc nếu
Tên tệp tiếp theo
fileNo = FreeFile
Mở newFileName để xuất dưới dạng #fileNo
In #fileKhông, kết quả
Đóng #fileKhông
Kết thúc phụ
Code này đúng ý mình r. Code chạy nhanh. Mình muốn hỏi thêm là chỗ firstHeader từ file 2 ,3 trở đi nó để cách một dòng trắng. Giờ mình lọc dữ liệu phải xoá bỏ những dòng ý. Bạn có thể giúp mình thêm lệnh xoá bỏ dòng không có dữ liệu được không. Mình cảm ơn nhiều..
Code này đúng ý mình r. Code chạy nhanh. Mình muốn hỏi thêm là chỗ firstHeader từ file 2 ,3 trở đi nó để cách một dòng trắng. Giờ mình lọc dữ liệu phải xoá bỏ những dòng ý. Bạn có thể giúp mình thêm lệnh xoá bỏ dòng không có dữ liệu được không. Mình cảm ơn nhiều..
Tôi chỉ biết một cách là duyệt từng dòng text, tìm dòng trống rồi xoá và cách làm này tất nhiên sẽ mất thời gian vì chạy vòng lặp.
(Cách tôi đang làm ở trên là đọc toàn bộ file một lần chứ không đọc từng dòng)
Do đó theo tôi thì chỉ nên code xoá dòng trong tác vụ kế tiếp khi thao tác trên dữ liệu của file CSV sau khi gộp đó.
Tôi chỉ biết một cách là duyệt từng dòng văn bản, tìm dòng trống rồi xóa và cách làm này tất nhiên sẽ mất thời gian vì chạy vòng lặp.
(Cách tôi đang làm ở trên là đọc toàn bộ tệp một lần chứ không đọc từng dòng)
Theo tôi, bạn chỉ nên xóa dòng mã trong nhiệm vụ tiếp theo khi thao tác tác vụ trên dữ liệu của tệp CSV sau khi phân vùng đó.
Đây là đoạn code của bạn befaid dùng để xoá dong trống nhưng mình chưa biết thêm vào đâu để chạy tiếp sau khi chạy xong code gộp log
Main phụ()
Dim Rng As Range
Set Rng = Sheet3.UsedRange
Application.ScreenUpdating = Sai
RemoveBlankRows Rng
Application.ScreenUpdating = True
end end
Sub RemoveBlankRows(ByVal sRng As Range)
Dim a(), maxR Dài, i Dài, j Dài, k Dài, maxC Dài
Dim Res(), sTxt dưới dạng chuỗi
Nếu sRng.Rows.Count = 1 Thì Thoát Sub
a = sRng.Value2
maxR = UBound(a, 1)
maxC = UBound(a, 2)
ReDim Res(1 Đến maxR, 1 Đến maxC)
Với i = 1 đến maxR
sTxt = ""
Với k = 1 đến maxC
sTxt = sTxt & a(i, k)
next k
If Len(sTxt) > 0 Thì
j = j + 1
Với k = 1 đến maxC
Res(j, k) = a(i, k)
next k
end if
next to my
sRng.ClearContents
Nếu j > 0 Thì sRng.Cells(1, 1).Resize(j, maxC).Value = Res
end end
Bài đã được tự động gộp:
Sub Main()
Dim Rng As Range
Set Rng = Sheets(1).UsedRange
Application.ScreenUpdating = False
RemoveBlankRows Rng
Application.ScreenUpdating = True
End Sub
Sub RemoveBlankRows(ByVal sRng As Range)
Dim a(), maxR As Long, i As Long, j As Long, k As Long, maxC As Long
Dim Res(), sTxt As String
If sRng.Rows.Count = 1 Then Exit Sub
a = sRng.Value2
maxR = UBound(a, 1)
maxC = UBound(a, 2)
ReDim Res(1 To maxR, 1 To maxC)
For i = 1 To maxR
sTxt = ""
For k = 1 To maxC
sTxt = sTxt & a(i, k)
Next k
If Len(sTxt) > 0 Then
j = j + 1
For k = 1 To maxC
Res(j, k) = a(i, k)
Next k
End If
Next i
sRng.ClearContents
If j > 0 Then sRng.Cells(1, 1).Resize(j, maxC).Value = Res
End Sub
Bài đã được tự động gộp:
Sub Main()
Dim Rng As Range
Set Rng = Sheets(1).UsedRange
Application.ScreenUpdating = False
RemoveBlankRows Rng
Application.ScreenUpdating = True
End Sub
Sub RemoveBlankRows(ByVal sRng As Range)
Dim a(), maxR As Long, i As Long, j As Long, k As Long, maxC As Long
Dim Res(), sTxt As String
If sRng.Rows.Count = 1 Then Exit Sub
a = sRng.Value2
maxR = UBound(a, 1)
maxC = UBound(a, 2)
ReDim Res(1 To maxR, 1 To maxC)
For i = 1 To maxR
sTxt = ""
For k = 1 To maxC
sTxt = sTxt & a(i, k)
Next k
If Len(sTxt) > 0 Then
j = j + 1
For k = 1 To maxC
Res(j, k) = a(i, k)
Next k
End If
Next i
sRng.ClearContents
If j > 0 Then sRng.Cells(1, 1).Resize(j, maxC).Value = Res
End Sub
Sub GopFiles()
Dim FilesToOpen() As Variant, newFileName As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="CSV Files (*.csv), *.csv", MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
newFileName = ThisWorkbook.Path & "\MergedCSVFiles.csv"
MergeCSVFiles FilesToOpen, newFileName, True, False
MsgBox "Xong."
'Mo file
CreateObject("Shell.Application").Open (newFileName)
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
Sub MergeCSVFiles(fileNames() As Variant, newFileName As String, Optional headers As Boolean = True, Optional addNewLine As Boolean = False)
'# fileNames: Danh sách tên file - array
'# newFilename: Tên file moi sau khi merge
'# headers: Du Lieu Co Dong Tieu De
'# addNewLine: Có thêm dòng moi cuoi file hay không
Dim fileName As Variant, textData As String, fileNo As Long, result As String
Dim addLastLine As Boolean, RefirstHeader As Boolean
For Each fileName In fileNames
fileNo = FreeFile
Open fileName For Input As #fileNo
textData = Input$(LOF(fileNo), fileNo) 'Doc toan bo File
Close #fileNo
If addLastLine Then result = result & vbNewLine
If RefirstHeader Then
result = result & Right(textData, Len(textData) - InStr(textData, vbNewLine) - 1)
Else
result = result & textData
End If
If headers Then RefirstHeader = True
If addNewLine Then addLastLine = True
Next fileName
fileNo = FreeFile
Open newFileName For Output As #fileNo
Print #fileNo, result
Close #fileNo
End Sub
Anh @HieuCD xử lý loại bỏ dòng cuối trống vậy là quá hay cho chủ thớt rồi, nhanh gọn, không cần vòng lặp. Với điều kiện mỗi file nguồn CSV phải có dòng trống cuối. Nếu không có dòng trống thì kết quả sẽ sai ngay.
--> Dòng đầu file kế tiếp sẽ được nối sát với cột cuối dòng cuối file trước.
Tôi không khuyến khích chủ thớt xử lý xoá "dòng trống ở cuối" (hoặc dòng trống ở vị trí bất kỳ trong 1 file) ở giai đoạn gộp file vì có thể mỗi file sẽ có hay không có "dòng trống cuối". Nếu chủ thớt chắc chắn file luôn có "dòng trống cuối" thì chạy code của anh là ngon lành cành đào.
Anh @HieuCD xử lý loại bỏ dòng cuối trống vậy là quá hay cho chủ thớt rồi, nhanh gọn, không cần vòng lặp. Với điều kiện mỗi file nguồn CSV phải có dòng trống cuối. Nếu không có dòng trống thì kết quả sẽ sai ngay.
View attachment 292624
--> Dòng đầu file kế tiếp sẽ được nối sát với cột cuối dòng cuối file trước.
Tôi không khuyến khích chủ thớt xử lý xoá "dòng trống ở cuối" (hoặc dòng trống ở vị trí bất kỳ trong 1 file) ở giai đoạn gộp file vì có thể mỗi file sẽ có hay không có "dòng trống cuối". Nếu chủ thớt chắc chắn file luôn có "dòng trống cuối" thì chạy code của anh là ngon lành cành đào.
InStr(textData, vbNewLine) là thứ tự ký tự xuống dòng "vbNewLine" của dòng tiêu đề là điểm nhận diện bắt đầu dữ liệu thực sự, nếu có dữ liệu sẽ có "vbNewLine"
Thêm lệnh kiểm tra ký tự "xuống dòng" cuối dữ liệu
Mã:
Sub MergeCSVFiles(fileNames() As Variant, newFileName As String, Optional headers As Boolean = True, Optional addNewLine As Boolean = False)
'# fileNames: Danh sách tên file - array
'# newFilename: Tên file moi sau khi merge
'# headers: Du Lieu Co Dong Tieu De
'# addNewLine: Có thêm dòng moi cuoi file hay không
Dim fileName As Variant, textData As String, fileNo As Long, result As String
Dim addLastLine As Boolean, RefirstHeader As Boolean, chCode As Long
For Each fileName In fileNames
fileNo = FreeFile
Open fileName For Input As #fileNo
textData = Input$(LOF(fileNo), fileNo) 'Doc toan bo File
Close #fileNo
chCode = Asc(Right(textData, 1))
If chCode <> 10 And chCode <> 13 Then textData = textData & vbNewLine
If addLastLine Then result = result & vbNewLine
If RefirstHeader Then
result = result & Right(textData, Len(textData) - InStr(textData, vbNewLine) - 1)
Else
result = result & textData
End If
If headers Then RefirstHeader = True
If addNewLine Then addLastLine = True
Next fileName
fileNo = FreeFile
Open newFileName For Output As #fileNo
Print #fileNo, result
Close #fileNo
End Sub
Cảm ơn @ongke0711 và anh @HieuCD. Code của anh chạy ổn và sửa được cái cách dòng rồi ạ. Giờ em muốn sửa Application.Getopenfilemane bằng Application.FileDialog(msoFileDialogFolderPicker) thì phải sửa code như thế nào ạ. Vì file log em quá nhiều cho filename nó không ghi được hết tên file log gây ra lỗi
Cảm ơn @ongke0711 và anh @HieuCD. Code của anh chạy ổn và sửa được cái cách dòng rồi ạ. Giờ em muốn sửa Application.Getopenfilemane bằng Application.FileDialog(msoFileDialogFolderPicker) thì phải sửa code như thế nào ạ. Vì file log em quá nhiều cho filename nó không ghi được hết tên file log gây ra lỗi
À lúc nãy tôi đọc không kỹ bài bạn viết là dùng mso..folderpickup nên mới nói bạn là dùng phương pháp chọn Folder cho nhanh chứ trong code thì chưa có. Bạn chỉ cần kiếm code lấy toàn bộ tên file (csv) trong folder đưa vào mảng rồi truyền mảng đó vào hàm hiện tại là được rồi.
À lúc nãy tôi đọc không kỹ bài bạn viết là dùng mso..folderpickup nên mới nói bạn là dùng phương pháp chọn Folder cho nhanh chứ trong code thì chưa có. Bạn chỉ cần kiếm code lấy toàn bộ tên file (csv) trong folder đưa vào mảng rồi truyền mảng đó vào hàm hiện tại là được rồi.
