Nhờ giúp đỡ Đọc dữ liệu từ nhiều file text có cấu trúc giống nhau và ghi dữ liệu vào bảng tính Excel

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Máy mình chạy hơn 8 giây. (core i5, ram 8 gb).
Giống cấu hình máy tôi. Nhưng của tôi là i5-Quad core 1.4GHz chứ không phải mấy con i5 bây giờ 8 nhân, 10 nhân mười mấy luồng... :D :D .
Bạn có chạy thử cái power query của bác ptm42 và hocexcel chưa? Có ra kết quả không? Không biết máy tôi bị gì mà nó cứ chạy hoài.
 
Lần chỉnh sửa cuối:
Tiếc là em không biết cách chèn code M và chạy. Nếu không thì cũng đua đòi thử tốc độ.
 
Tiếc là em không biết cách chèn code M và chạy. Nếu không thì cũng đua đòi thử tốc độ.
Bạn vô menu Data - Get Data - chọn Launch Power Query Editor. Sau đó trong cửa sổ Editor - menu New Query - chọn New Source - Other Source - Blank query. Trong cửa số Query chọn Advanced Edit - dán M code vào --> close and load.
 
Code VBA FSO ở bài 12 tôi chạy 2.5 giây, nhanh gấp 10 lần PQ của tôi.
 
Có một chia sẽ thêm là về M-code: Tôi thấy file bác @ptm0412@hocexcel_1991 có dùng Delimiter = " " thì trên máy tôi báo lỗi (Office 365 bản quyền). (Không biết có do lỗi copy code lên diễn đàn không?)
- Nếu tôi sửa thành Delimiter=" " (1 khoảng trắng) thì không lỗi nhưng chạy không ra kết quả.
- Nếu tôi đổi thành Delimiter ="#(tab)" thì máy tôi mới chạy được.
Code của bạn @hocexcel_1991 chạy nhanh đó, bằng 1/10 của bác @ptm0412 . Chắc là đã tinh chỉnh rồi.

Screen Shot 2024-08-25 at 11.31.52.png
 
Tôi chọn tab và nó ra câu lệnh như vậy. Có lẽ khi copy ra ngoài nó biến thành 4 khoảng trắng chăng.

1724562298410.png

1724562310068.png

Code của bạn @hocexcel_1991 chạy nhanh đó, bằng 1/10 của bác @ptm0412
Code đó lồng hàm nhiều quá tôi chưa xem hết, Còn tôi thì ít khi lồng hàm như đã nói ở trên. Phải tách hàm ra nhiều dòng mới hiểu thuật toán.
 
Lần chỉnh sửa cuối:
Có một chia sẽ thêm là về M-code: Tôi thấy file bác @ptm0412@hocexcel_1991 có dùng Delimiter = " " thì trên máy tôi báo lỗi (Office 365 bản quyền). (Không biết có do lỗi copy code lên diễn đàn không?)
- Nếu tôi sửa thành Delimiter=" " (1 khoảng trắng) thì không lỗi nhưng chạy không ra kết quả.
- Nếu tôi đổi thành Delimiter ="#(tab)" thì máy tôi mới chạy được.
Code của bạn @hocexcel_1991 chạy nhanh đó, bằng 1/10 của bác @ptm0412 . Chắc là đã tinh chỉnh rồi.

View attachment 303416
Code chạy nhanh chủ yếu do cái lệnh Table.buffer + load đồng thời mới Trasform đó bác, tác vụ load trên bộ nhớ tạm cho nên không phải load lại, code đó máy mạnh chắc chỉ mất 2,3 giây thôi
 
Code chạy nhanh chủ yếu do cái lệnh Table.buffer + load đồng thời mới Trasform đó bác, tác vụ load trên bộ nhớ tạm cho nên không phải load lại, code đó máy mạnh chắc chỉ mất 2,3 giây thôi
À...Phải có kỹ thuật gì đó chứ đâu thể Power query chạy chậm một cách cách biệt như vậy được . :)
 
Code chạy nhanh chủ yếu do cái lệnh Table.buffer + load đồng thời mới Trasform đó bác, tác vụ load trên bộ nhớ tạm cho nên không phải load lại, code đó máy mạnh chắc chỉ mất 2,3 giây thôi
Code đó (PQ bài 17) tôi chạy mất 10 giây, khoảng 0.4 thời gian so với code của tôi.
 
Em sửa code của Thầy Mỹ một tí:
Mã:
let
    StartTime = DateTime.LocalNow(),
    Source = Folder.Files("C:\Users\Admin\Desktop\GPE\nuocthai"),
    KeepContent = Table.SelectColumns(
                    Table.TransformColumns(Source, {"Content", each
                    let
                        FileContent = Csv.Document(_, [Delimiter="    ", Columns=5, Encoding=1252, QuoteStyle=QuoteStyle.None]),
                        NonEmptyTable = if Table.RowCount(FileContent) > 0 then FileContent else Table.FromRecords({[Column1="0", Column2="0", Column3="0", Column4="0"]}),
                        AddTitle = Table.AddColumn(NonEmptyTable, "Title", each if Text.Length([Column3]) > 0 then [Column1] & " (" & [Column3] & ")" else [Column1]),
                        ChooseCols = Table.SelectColumns(AddTitle, {"Title", "Column2", "Column4"}),
                        TransData = Table.PromoteHeaders(Table.Transpose(ChooseCols)),
                        pHValue = try TransData[pH]{1} otherwise null,
                        // Tách ngày tháng
                        AddYear = if pHValue <> null then Table.AddColumn(TransData, "Year", each Number.From(Text.Start(pHValue, 4)), Int64.Type) else TransData,
                        AddMonth = if pHValue <> null then Table.AddColumn(AddYear, "Month", each Number.From(Text.Middle(pHValue, 4, 2)), Int64.Type) else AddYear,
                        AddDay = if pHValue <> null then Table.AddColumn(AddMonth, "Day", each Number.From(Text.Middle(pHValue, 6, 2)), Int64.Type) else AddMonth,
                        AddHour = if pHValue <> null then Table.AddColumn(AddDay, "Hour", each #time(Number.From(Text.Middle(pHValue, 8, 2)), Number.From(Text.Middle(pHValue, 10, 2)), Number.From(Text.Middle(pHValue, 12, 2)))) else AddDay
                    in
                        Table.FirstN(AddHour, 1)
                }),{"Content"}),
    Expanded_Tbl = Table.ExpandTableColumn(KeepContent, "Content", {"COD (mg/L)", "TSS (mg/L)", "pH", "NH4+ (mg/L)", "Temp (oC)", "NO3- (mg/L)", "Flow out 1 (M3/h)", "Year", "Month", "Day", "Hour"}, {"COD (mg/L)", "TSS (mg/L)", "pH", "NH4+ (mg/L)", "Temp (oC)", "NO3- (mg/L)", "Flow out 1 (M3/h)", "Year", "Month", "Day", "Hour"}),
    EndTime = DateTime.LocalNow(),
    Duration = Duration.TotalSeconds(EndTime - StartTime),
    AddExecutionTime = Table.AddColumn(Expanded_Tbl, "ExecutionTimeInSeconds", each Duration, type number)
in
    AddExecutionTime
Cơ bản vẫn chậm hơn code của bạn @hocexcel_1991 một chút ở chỗ bạn tạo cột động cho ngày tháng năm
 
Lúc đầu em có sử dụng fso strem. Nhưng nó lỗi 1 số file. Không hiểu là lí do ở chỗ nào. Nên đành phải dùng Freefile anh ạ
Không phải lỗi, chỉ là trong danh sách tệp có tệp rỗng, nên không thể gọi ReadAll.


Tối ưu mã lại như sau, nếu data được xử tại memory mã sẽ nhanh hơn nữa:

JavaScript:
Option Explicit

#If VBA7 Then
Private Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As LongPtr) As Long
Private Declare PtrSafe Function FindFirstFileW Lib "kernel32" (ByVal lpFileName As LongPtr, ByVal lpFindFileData As LongPtr) As LongPtr
Private Declare PtrSafe Function FindNextFileW Lib "kernel32" (ByVal hFindFile As LongPtr, ByVal lpFindFileData As LongPtr) As LongPtr
#Else
Private Enum LongPtr: [_]: End Enum
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal lpFindFileData As Long) As Long
Private Declare Function FindNextFileW Lib "kernel32" (ByVal hFindFile As Long, ByVal lpFindFileData As Long) As Long
#End If
Private Type FILETIME
  dwLowDateTime  As Long
  dwHighDateTime As Long
End Type
Const MAX_PATH  As Long = 260
Const ALTERNATE As Long = 14
Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime   As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime  As FILETIME
  nFileSizeHigh    As Long
  nFileSizeLow     As Long
  dwReserved0      As Long
  dwReserved1      As Long
  cFileName        As String * MAX_PATH
  cAlternate       As String * ALTERNATE
End Type
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = 16 '0x10
Private Const INVALID_HANDLE_VALUE As LongPtr = -1

Sub TongHop2()
    Dim folderPath As String, fileList As Collection, fileName As Variant, s, v$, k&, j%, data
    Dim startTime As Double, fd, txtFile, sText As String
    Dim endTime As Double
    Dim elapsedTime As Double, fileNumber
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    If fd.Show = -1 Then
        folderPath = fd.SelectedItems(1) & "\"
    Else
        MsgBox "Ban chua chon thu muc nao": Exit Sub
    End If
   ' folderPath = ThisWorkbook.Path & "\nuocthai\"
    startTime = timer
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set fileList = New Collection
    Call ListAllFiles(folderPath, fileList)
    ReDim data(1 To fileList.count + 5000, 1 To 12)
    For Each fileName In fileList
      fileNumber = FreeFile
      Open fileName For Input As #fileNumber
      s = Split(Replace$(Input$(LOF(fileNumber), fileNumber), vbCrLf, vbTab), vbTab)
      Close #fileNumber
      If UBound(s) > 20 Then
        k = k + 1: v = s(3)
        data(k, 1) = k
        data(k, 2) = Left$(v, 4)
        data(k, 3) = Mid$(v, 5, 2)
        data(k, 4) = Mid$(v, 7, 2)
        data(k, 5) = Mid$(v, 9, 2) & ":" & Mid$(v, 11, 2) & ":" & Right$(v, 2)
        For j = 0 To 6
          data(k, 6 + j) = s(j * 5 + 1)
        Next
      End If
    Next
    If k > 0 Then
      With sheets("Sheet1") 'ActiveSheet '
        .Range("A3").Resize(UBound(data), 12).Value = data
      End With
    End If
    endTime = timer
    elapsedTime = endTime - startTime
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Hoàn Thành :" & elapsedTime & "s"
End Sub
Public Sub ListAllFiles(ByVal folder$, ByRef fileList As Collection)
  Dim h As LongPtr, f$, fd As WIN32_FIND_DATA
  h = FindFirstFileW(StrPtr(folder & "*"), VarPtr(fd))
  If h = INVALID_HANDLE_VALUE Then Exit Sub
  Do While FindNextFileW(h, VarPtr(fd))
    f = fd.cFileName
    If f Like "[.~]*" Then
    ElseIf fd.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
      Call ListAllFiles(folder & Left$(f, InStr(f, vbNullChar) - 1) & "\", fileList)
    Else
      fileList.Add folder & f
    End If
  Loop
  FindClose h
End Sub
 
Lần chỉnh sửa cuối:
Không hiểu được bao nhiêu, chỉ nhảy vô test xem cái nào nhanh hơn thôi, VBA #12 7s, PQ #33 thì 22s, VBA #34 chạy ko ra kết quả không biết do lỗi gì. Vậy nếu chỉ lấy dữ liệu thôi thì chọn VBA rồi :)))
 
Không biết lỗi gì bạn có thể chụp hình mã không.

dòng mã folderPath phải là: folderPath = fd.SelectedItems(1) & "\"
bên máy bạn có đúng vậy không

1724602649110.png
 
Không hiểu được bao nhiêu, chỉ nhảy vô test xem cái nào nhanh hơn thôi, VBA #12 7s, PQ #33 thì 22s, VBA #34 chạy ko ra kết quả không biết do lỗi gì. Vậy nếu chỉ lấy dữ liệu thôi thì chọn VBA rồi :)))
Chỉ trong phạm vi bài toán này thì đương nhiên Power Query sẽ không có cửa so với VBA, vì bài toán này dữ liệu chỉ hơn 26 ngàn dòng thôi, trong phạm vi dưới 100 ngàn dòng thì VBA sẽ là lựa chọn tốt hơn so với Power Query. Dữ liệu càng lớn thì Power Query sẽ ưu việt hơn VBA, đặc biệt với dữ liệu hàng triệu dòng trở lên.
 
Chỉ trong phạm vi bài toán này thì đương nhiên Power Query sẽ không có cửa so với VBA, vì bài toán này dữ liệu chỉ hơn 26 ngàn dòng thôi, trong phạm vi dưới 100 ngàn dòng thì VBA sẽ là lựa chọn tốt hơn so với Power Query. Dữ liệu càng lớn thì Power Query sẽ ưu việt hơn VBA, đặc biệt với dữ liệu hàng triệu dòng trở lên.
Tui nghĩ đọc dữ liệu từ file lớn thì PQ mới phát huy thế mạnh chứ lấy dữ liệu từ nhiều file nhỏ thế này thì VBA vẫn hơn
 
Tui nghĩ đọc dữ liệu từ file lớn thì PQ mới phát huy thế mạnh chứ lấy dữ liệu từ nhiều file nhỏ thế này thì VBA vẫn hơn
Đó chỉ mới là lấy dữ liệu. Có dữ liệu rồi xử lý cho phù hợp để ra báo cáo thiên hình vạn trạng là chuyện khác.
Nói riêng về VBA, nếu 2s so với 20s thì còn nghĩ đến chuyện hơn, chứ 2s so với 2.5s hoặc so với 2.2s thì tôi chọn cái đơn giản. Viết thêm 1 thước code mà chỉ tiết kiệm 1 vài giây trở xuống thì tôi không cần.
Nói về PQ (Power query) thì phù hợp với dữ liệu lớn, bất kể nhiều file nhỏ (hàng ngàn file) hay vài file lớn (hàng chục file), khi mà dữ liệu vài trăm ngàn dòng, thậm chí vượt quá 1 triệu dòng. Người ta chấp nhận chạy 15, 20 phút hoặc nửa tiếng để lấy nhiều triệu dòng. Excel có chỗ chứa mấy triệu dòng cho kết quả của PQ nhưng không có chỗ chứa cho kết quả VBA.
Ngoài ra, PQ còn kết hợp với DAX trong DataModel còn làm được nhiều việc mà nếu dùng VBA phải rất nhọc công, thậm chí không làm được.
 
Lần chỉnh sửa cuối:
Web KT

Bài viết mới nhất

Back
Top Bottom