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

thanhduytlv

Thành viên mới
Tham gia ngày
4 Tháng bảy 2010
Bài viết
34
Được thích
4
Điểm
365
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.
 

File đính kèm

huuduy.duy

Thành viên tích cực
Tham gia ngày
29 Tháng mười 2010
Bài viết
827
Được thích
109
Điểm
420
Nơi ở
Cà Mau
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
Capture.PNG
 

hpkhuong

######
Tham gia ngày
20 Tháng năm 2011
Bài viết
4,624
Được thích
4,084
Điểm
560
Nơi ở
Quận 2 - TP.HCM
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?).
Mã:
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
 
Top Bottom