Lấy dữ liệu từ File CSV (file ngân hàng) và xóa những hàng trùng lặp ?

[ericnguyen83]

Xin chào mọi người, tôi là quản lý bên cty vận tải, tình hình là tôi cần thao tác với file ngân hàng (.CSV) mà tôi thì không rành về VBA. Nên hôm nay, tôi muốn nhờ tới các bạn lặp trình chuyên sâu phần này giúp tôi công cụ để xử lý công việc tại cty. Tôi xin chân thành cảm ơn và gữi hậu tạ tới file mà đáp ứng được nhu cầu công việc của tôi. Mong mọi người giúp đỡ.

File .rar bao gồm: File Excel chính chứa thông tin cần làm và yêu cầu cụ thể + File CSV ngân hàng 1-2-3

Thông tin liên hệ:
Nguyễn Minh Hiếu
0938.99.hai hai. sáu sáu

 

[snow25]

Xin chào mọi người, tôi là quản lý bên cty vận tải, tình hình là tôi cần thao tác với file ngân hàng (.CSV) mà tôi thì không rành về VBA. Nên hôm nay, tôi muốn nhờ tới các bạn lặp trình chuyên sâu phần này giúp tôi công cụ để xử lý công việc tại cty. Tôi xin chân thành cảm ơn và gữi hậu tạ tới file mà đáp ứng được nhu cầu công việc của tôi. Mong mọi người giúp đỡ.

File .rar bao gồm: File Excel chính chứa thông tin cần làm và yêu cầu cụ thể + File CSV ngân hàng 1-2-3

Thông tin liên hệ:
Nguyễn Minh Hiếu
0938.99.hai hai. sáu sáu

Thử code.

Sub laydulieu()
    Dim i As Long, lr As Long, arr, fso As Object, FilesToOpen, T, Res, LineNum, ItemsOfLine, S As String
    Dim TextSource As Object, TotalLines, TextItem, K As Long, cols As Long, dic As Object, kq(1 To 10000, 1 To 8), a As Long
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set dic = CreateObject("scripting.dictionary")
    FilesToOpen = Application.GetOpenFilename("Text Files (, *.csv", , , , True)
    If Not IsArray(FilesToOpen) Then Exit Sub
    a = 1
    For Each T In FilesToOpen
        kq(a, 1) = fso.GetBaseName(T)
        kq(a, 2) = Format(FileDateTime(T), "DD-MM-YYYY")
        Set TextSource = fso.OpenTextFile(T, 1, False, -2)
        TotalLines = Split(TextSource.ReadAll, vbCrLf)
      For LineNum = 3 To UBound(TotalLines)-1
            ItemsOfLine = TotalLines(LineNum)
            If Not dic.exists(ItemsOfLine) Then
                TextItem = Split(ItemsOfLine, ",")
                For cols = 1 To UBound(TextItem)
                    kq(a, cols + 2) = Application.Trim(TextItem(cols))
                Next
                a = a + 1
                dic.Add ItemsOfLine, ""
            End If
      Next
    Next T
    With Sheets("sheet1")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         If lr > 6 Then .Range("A7:H" & lr).ClearContents
         If a Then
            .Range("A7:G7").Resize(a).Value = kq
         End If
    End With
    Set dic = Nothing
    Set fso = Nothing
End Sub

 

[ericnguyen83]

Đã được hỗ trợ, cảm ơn mọi người rất nhiều