Đọ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 (1 người xem)

[thaoeqn1983]

Em chào các anh/chị trên diễn đàn GPE.
Nhờ các anh chị giúp vấn đề này với, nội dung như sau:
-Em có nhiều file text (.txt) có cấu trúc giống nhau (do xuất dữ liệu từ một phần mềm GIS). Trong file này có dữ liệu tọa độ mà em cần dùng.
-Em muốn xây dựng một tool nhỏ đọc hàng loạt các file .txt trên và ghi dữ liệu ra bảng tính excel theo mẫu đính kèm (chỉ cần 01 vài trường dữ liệu).
(đính kèm thư mục file .txt, file Read TXT Tool.xlsb tạo sẵn, có mô tả các trường dữ liệu cần lấy)
Em cám ơn.

 

[Maika8008]

Em chào các anh/chị trên diễn đàn GPE.
Nhờ các anh chị giúp vấn đề này với, nội dung như sau:
-Em có nhiều file text (.txt) có cấu trúc giống nhau (do xuất dữ liệu từ một phần mềm GIS). Trong file này có dữ liệu tọa độ mà em cần dùng.
-Em muốn xây dựng một tool nhỏ đọc hàng loạt các file .txt trên và ghi dữ liệu ra bảng tính excel theo mẫu đính kèm (chỉ cần 01 vài trường dữ liệu).
(đính kèm thư mục file .txt, file Read TXT Tool.xlsb tạo sẵn, có mô tả các trường dữ liệu cần lấy)
Em cám ơn.

Nhớ sửa đường dẫn chứa các file txt trong code!
(Tôi đã từng làm chỗ với bạn đấy)
File của bạn:

 

[giaiphap]

Em chào các anh/chị trên diễn đàn GPE.
Nhờ các anh chị giúp vấn đề này với, nội dung như sau:
-Em có nhiều file text (.txt) có cấu trúc giống nhau (do xuất dữ liệu từ một phần mềm GIS). Trong file này có dữ liệu tọa độ mà em cần dùng.
-Em muốn xây dựng một tool nhỏ đọc hàng loạt các file .txt trên và ghi dữ liệu ra bảng tính excel theo mẫu đính kèm (chỉ cần 01 vài trường dữ liệu).
(đính kèm thư mục file .txt, file Read TXT Tool.xlsb tạo sẵn, có mô tả các trường dữ liệu cần lấy)
Em cám ơn.

Thử code này xem sao.

Sub LoadTXT()
  Dim StrLine As String
    Dim FSO As Object
    Dim TSO As Object
    Dim StrLineElements As Variant
    Dim Index As Long
    Dim i As Long, j As Long, k As Integer
    Dim Arr()
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Text Files", "*.txt"
        If .Show = True Then
            ReDim Arr(1 To .SelectedItems.Count, 1 To 6)
            j = Sheet1.Range("B100000").End(xlUp).Row - 4
            For i = 1 To .SelectedItems.Count
                Set TSO = FSO.OpenTextFile(.SelectedItems(i))
                Arr(i, 1) = j + i
                Arr(i, 2) = FSO.GetBaseName(.SelectedItems(i))
                Index = 0: k = 0
                Do While TSO.AtEndOfStream = False
                    StrLine = TSO.ReadLine
                    StrLineElements = Split(StrLine, "=")
                    Select Case StrLineElements(0)
                        Case "UPPER LEFT X": Index = 3
                        Case "UPPER LEFT Y": Index = 4
                        Case "LOWER RIGHT X": Index = 5
                        Case "LOWER RIGHT Y": Index = 6
                    End Select
                    If Index > 0 Then
                        Arr(i, Index) = StrLineElements(1)
                        k = k + 1
                        If k = 4 Then Exit Do
                    End If
                Loop
                TSO.Close
            Next i
            Sheet1.Range("B100000").End(xlUp).Offset(1).Resize(i - 1, 6).Value = Arr
        End If
    End With
    Set FSO = Nothing
End Sub

 

[thaoeqn1983]

Code chạy rất tốt và nhanh, cám ơn bạn.

 

[Maika8008]

Code chạy rất tốt và nhanh, cám ơn bạn.

Ủa, chớ bạn nào?

 

[Hoàng Tuấn 868]

Ủa, chớ bạn nào?

Chắc là chạy nhanh như nhau nên gộp luôn cho gọn.

 

[thaoeqn1983]

Bạn Maika8008 là ai nhỉ, từng làm chỗ cơ quan mình à?
Ở trên mình nói không rõ, mới chạy được code của bạn "giaiphap" thấy OK, còn của bạn "Maika8008"... để mình test thử đã nhé, cám ơn.

Bài đã được tự động gộp: 6/11/21

Test và so sánh code của 2 bạn đã góp ý.
-Về kết quả: cả 2 đều cho ra kết quả chính xác.
-Về tốc độ: code của bạn "Maika8008" chạy nhanh hơn.... (do mặc đinh thư mục file, không tốn thời gian chọn..).
-Về độ linh hoạt: code của bạn "giaiphap" linh hoạt hơn.... (thư mục file để đâu cũng chọn được).
=> Tóm lại, nếu bỏ cái chọn đường dẫn thư mục file (mặc định hoặc chọn) thì code 2 bạn chạy nhanh như nhau. Một lần nữa cám ơn 2 bạn đã góp ý, cám ơn GPE.

 

[vanthinh3101]

Sử dụng Power Query có vẻ khá ngon.
Bạn kiểm tra xem đúng không?
Bạn chỉ cần thay đổi đường dẫn dòng Source là được nhé!

let
    Source = Folder.Files("C:\Users\Admin\Desktop\L1_TXT"),
    RemovedOtherColumns = Table.SelectColumns(Source,{"Content", "Name"}),
    GetLinesFromTxtFiles = Table.AddColumn(RemovedOtherColumns, "Custom", each Lines.FromBinary([Content])),
    GetRightLines = Table.AddColumn(GetLinesFromTxtFiles, "Custom.1", each List.Range([Custom],0,4)),
    RemovedColumns = Table.RemoveColumns(GetRightLines,{"Content", "Custom"}),
    ExpandedRightLines = Table.ExpandListColumn(RemovedColumns, "Custom.1"),
    SplitColumnbyDelimiter = Table.SplitColumn(ExpandedRightLines, "Custom.1", Splitter.SplitTextByDelimiter("=", QuoteStyle.Csv), {"Custom.1.1", "Custom.1.2"}),
    ChangedType = Table.TransformColumnTypes(SplitColumnbyDelimiter,{{"Custom.1.1", type text}, {"Custom.1.2", type number}}),
    PivotedColumn = Table.Pivot(ChangedType, List.Distinct(ChangedType[Custom.1.1]), "Custom.1.1", "Custom.1.2"),
    AddedIndexColumn = Table.AddIndexColumn(PivotedColumn, "Index", 1, 1, Int64.Type),
    RenamedColumns = Table.RenameColumns(AddedIndexColumn,{{"Index", "STT"}, {"Name", "Tên file"}}),
    ReorderedColumns = Table.ReorderColumns(RenamedColumns,{"STT", "Tên file", "UPPER LEFT X", "UPPER LEFT Y", "LOWER RIGHT X", "LOWER RIGHT Y"})
in
    ReorderedColumns

 

[Hoàng Tuấn 868]

code 2 bạn chạy nhanh như nhau.

Đoán trúng luôn mà.

 

[Maika8008]

Bạn Maika8008 là ai nhỉ, từng làm chỗ cơ quan mình à?

Là ai thì bạn bấm vào biểu tượng Momo dưới nink tôi thì sẽ biết. Còn đúng là tôi đã làm 1 thời gian ngắn ở cơ quan bạn đã/đang làm.