Code VBA lấy dữ liệu từ TXT sang Excel.

[thanhduytlv]

Kính chào diễn đàn GPE
Mình đang có vấn đề này mạo muội nhờ bạn giúp dùm. Code VBA:

Gộp tất cả file TXT ( trong 1 thư mục ) làm 1 file TXT tổng
Lấy dữ liệu từ file TXT tổng vào file EXE và lưu tại thư mục chỉ định sẵn. ( File TXT => chạy từ chương trình nội bộ xuất ra file TXT )
File đính kèm
Lưu ý: cột On Hand có số dương hoặc số âm (dấu trừ sau số lượng. Vd: 7- ) à
Nhờ các bạn, anh, chị hổ trợ code VBA làm theo yêu cầu dùm do mỗi ngày đều phải làm các thao tác này.
Cám ơn rất nhiều.

 

[Excel365]

Kính chào diễn đàn GPE
Mình đang có vấn đề này mạo muội nhờ bạn giúp dùm. Code VBA:

Gộp tất cả file TXT ( trong 1 thư mục ) làm 1 file TXT tổng
Lấy dữ liệu từ file TXT tổng vào file EXE và lưu tại thư mục chỉ định sẵn. ( File TXT => chạy từ chương trình nội bộ xuất ra file TXT )
File đính kèm
Lưu ý: cột On Hand có số dương hoặc số âm (dấu trừ sau số lượng. Vd: 7- ) à
Nhờ các bạn, anh, chị hổ trợ code VBA làm theo yêu cầu dùm do mỗi ngày đều phải làm các thao tác này.
Cám ơn rất nhiều.

Dùng chức năng Import txt vẫn được mà bạn

 

[hpkhuong]

Kính chào diễn đàn GPE
Mình đang có vấn đề này mạo muội nhờ bạn giúp dùm. Code VBA:

Gộp tất cả file TXT ( trong 1 thư mục ) làm 1 file TXT tổng
Lấy dữ liệu từ file TXT tổng vào file EXE và lưu tại thư mục chỉ định sẵn. ( File TXT => chạy từ chương trình nội bộ xuất ra file TXT )
File đính kèm
Lưu ý: cột On Hand có số dương hoặc số âm (dấu trừ sau số lượng. Vd: 7- ) à
Nhờ các bạn, anh, chị hổ trợ code VBA làm theo yêu cầu dùm do mỗi ngày đều phải làm các thao tác này.
Cám ơn rất nhiều.

Viết theo dữ liệu của bạn - Chỉ lấy dữ liệu, cắt bỏ râu ria...
Hên xui nhé! Chỉ đúng khi phần mềm của bạn xuất ra đúng như Format trên file txt đính kèm.
(Góp ý: Phần mềm xuất ra ngày là text thì phải đầy đủ Format ngày chứ ví dụ là dd/mm/yyyy hoặc mm/dd/yyyy hoặc yyyy/mm/dd, hiện tại của bạn chỉ có d/mm/yy -> Khi cần xác định Năm chính xác thì = niềm tin ah?).

Public Sub GPE()
Dim Fso As Object, ObjFile As Object, TextS As Object, TLines, NoS, NeS As String
Dim sArr, Item, K As Long, I As Long, sKU, Str As String, OnH As String
ReDim sArr(1 To 10000, 1 To 13)

Set Fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Txt Files", "*.txt", 1
    If Not .Show = -1 Then
        MsgBox "Ban chua chon File", vbInformation, "----Mr.GPE----"
        Exit Sub
    End If
'On Error Resume Next
For Each Item In .SelectedItems
    Set TextS = Fso.OpenTextFile(Item, 1, , -2)
        TLines = Split(TextS.ReadAll, vbCrLf)
        For I = LBound(TLines) To UBound(TLines)
        Str = TLines(I)
        If Application.Trim(Left(Str, 14)) = "Store" Then
            NoS = VBA.Replace(Application.Trim(Mid(TLines(I), 15, 7)), ":", "")
            NeS = Application.Trim(Mid(TLines(I), 22, 47))
        End If
        sKU = Val(Left(Str, 11))
            If IsNumeric(sKU) And Len(sKU) = 7 Then
                K = K + 1
                sArr(K, 1) = NoS
                sArr(K, 2) = NeS
                sArr(K, 3) = sKU
                sArr(K, 4) = Application.Trim(Mid(TLines(I), 12, 41))
                               
                OnH = Application.Trim(Mid(TLines(I), 53, 11))
               
                If Right(OnH, 1) = "-" Then
                    sArr(K, 5) = -Replace(OnH, "-", "")
                Else
                    sArr(K, 5) = OnH
                End If
               
                sArr(K, 6) = Application.Trim(Mid(TLines(I), 64, 19))
                sArr(K, 7) = Application.Trim(Mid(TLines(I), 83, 20))
                sArr(K, 8) = Application.Trim(Mid(TLines(I), 103, 12))
                sArr(K, 9) = Application.Trim(Mid(TLines(I), 115, 23))
                sArr(K, 10) = Application.Trim(Mid(TLines(I), 138, 23))
                sArr(K, 11) = Application.Trim(Mid(TLines(I), 161, 12))
                sArr(K, 12) = Application.Trim(Mid(TLines(I), 173, 10))
                sArr(K, 13) = Application.Trim(Right(TLines(I), 8))
            End If
        Next
Next
End With
Range("A1").CurrentRegion.Offset(1).ClearContents
If K Then
    Range("K2").Resize(K, 3).NumberFormat = "@"
    Range("A2").Resize(K, 13).Value = sArr
    For I = 0 To 2
        Range("K2").Resize(K).Offset(, I).TextToColumns Range("K2").Offset(, I), xlFixedWidth, FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
    Next
End If
MsgBox "Done!"
Application.ScreenUpdating = True
End Sub