Xin giúp đỡ code VBA chép cột dữ liệu có điều kiện từ file này sang file khác (2 người xem)

[acrox84]

Chào mọi người, mình làm ở điểm gom hàng Chuyển phát nhanh, nhiệm vụ của mình là mỗi thứ Hai, Tư, Sáu xuất file excel, lọc cột "Thời gian ký nhận" của shipper giao hàng thành công mà trả tiền cho Khách gửi.
Đầu tháng này, bên IT tăng độ khó game, tách cột cần thiết này qua file riêng khác, làm mình dò thủ công mờ cả mắt, chỉ sợ số liệu nhiều làm sai sót trả lộn tiền cho khách thì toi đời, nên mong mọi người giúp đỡ cách xử lý tốt hơn. Cảm ơn mọi người rất rất nhiều!

Mô tả vấn đề:
1) Dựa trên Mã Đơn (cột A) copy "Thời gian ký nhận" (cột L, file dulieu2) tương ứng sang cột trống AH ở file dulieu1
2) Do file dulieu1 và dulieu2, mình xuất và thay thế thường xuyên nên có tác giả nào cho file excel kèm nút đính code VBA có chức năng gộp 2 file thành file dulieu.xlsx thì mình tiện sử dụng hơn.
Đặc điểm 2 file này khi export ra là không thay đổi cấu trúc hoặc thứ tự các cột dữ liệu đều cố định như tệp đính kèm.

*Trường hợp đúng thì sẽ có kết quả mong muốn như thế này ở cột AH:


p/s: nếu yêu cầu nhờ vả có độ khó cao hoặc có gì quá đáng thì mong các bạn bỏ qua, nhu cầu của mình cấp thiết như thế mà cũng không quen bạn nào giỏi code VBA nên mạo muội lập thớt nhờ vả..
Chúc mọi người cuối tuần vui vẻ ^^!

 

[Hoàng Nhật Phương]

Chào mọi người, mình làm ở điểm gom hàng Chuyển phát nhanh, nhiệm vụ của mình là mỗi thứ Hai, Tư, Sáu xuất file excel, lọc cột "Thời gian ký nhận" của shipper giao hàng thành công mà trả tiền cho Khách gửi.
Đầu tháng này, bên IT tăng độ khó game, tách cột cần thiết này qua file riêng khác, làm mình dò thủ công mờ cả mắt, chỉ sợ số liệu nhiều làm sai sót trả lộn tiền cho khách thì toi đời, nên mong mọi người giúp đỡ cách xử lý tốt hơn. Cảm ơn mọi người rất rất nhiều!

Mô tả vấn đề:
1) Dựa trên Mã Đơn (cột A) copy "Thời gian ký nhận" (cột L, file dulieu2) tương ứng sang cột trống AH ở file dulieu1
2) Do file dulieu1 và dulieu2, mình xuất và thay thế thường xuyên nên có tác giả nào cho file excel kèm nút đính code VBA có chức năng gộp 2 file thành file dulieu.xlsx thì mình tiện sử dụng hơn.
Đặc điểm 2 file này khi export ra là không thay đổi cấu trúc hoặc thứ tự các cột dữ liệu đều cố định như tệp đính kèm.

*Trường hợp đúng thì sẽ có kết quả mong muốn như thế này ở cột AH:
View attachment 288630

p/s: nếu yêu cầu nhờ vả có độ khó cao hoặc có gì quá đáng thì mong các bạn bỏ qua, nhu cầu của mình cấp thiết như thế mà cũng không quen bạn nào giỏi code VBA nên mạo muội lập thớt nhờ vả..
Chúc mọi người cuối tuần vui vẻ ^^!

Bạn tham khảo :

Option Explicit

Private Sub CommandButton1_Click()
    
    Dim fso As Object, dic As Object
    Dim sheet As Worksheet, wbOpen As Workbook
    Dim arr As Variant
    Dim sFolderName As String, fileName As String
    Dim i As Long, r As Long
    Dim c As Integer
    Dim bFileOpened As Boolean
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    On Error GoTo End_
    
    Set sheet = ThisWorkbook.ActiveSheet
    sFolderName = sheet.Range("C4")
    fileName = sheet.Range("C8")
    Set fso = CreateObject("Scripting.FileSystemObject")
    GoSub checkBook_
    
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        dic.Item(arr(i, 1)) = arr(i, 12)
    Next i
    If Not bFileOpened Then wbOpen.Close False
    Set wbOpen = Nothing
    fileName = sheet.Range("C6")
    GoSub checkBook_
    r = UBound(arr, 1): c = UBound(arr, 2) + 1
    ReDim Preserve arr(1 To UBound(arr, 1), 1 To c)
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        If dic.Exists(arr(i, 1)) Then
            arr(i, c) = dic.Item(arr(i, 1))
        End If
    Next i
    With wbOpen.Worksheets(1).Range("A1")
        .Resize(r, c) = arr
        .Offset(, c - 1).Resize(r).NumberFormat = "yyyy-mm-dd hh:mm:ss"
    End With
    wbOpen.Save
    If Not bFileOpened Then wbOpen.Close False
    Set wbOpen = Nothing
    
    GoTo End_
    
checkBook_:
    If fso.FileExists(sFolderName & "\" & fileName) Then
        On Error Resume Next
        Set wbOpen = Workbooks(fileName)
        On Error GoTo 0
        If wbOpen Is Nothing Then
            Set wbOpen = Workbooks.Open(sFolderName & "\" & fileName)
            bFileOpened = False
        End If
        arr = wbOpen.Worksheets(1).Range("A1").CurrentRegion.Value
    Else
        MsgBox "Khong tim thay tap tin " & fileName & vbNewLine & _
            " trong thu muc " & sFolderName, vbCritical
        Exit Sub
    End If
    
    Return

End_:

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    
End Sub

 

[HUONGHCKT]

Chào mọi người, mình làm ở điểm gom hàng Chuyển phát nhanh, nhiệm vụ của mình là mỗi thứ Hai, Tư, Sáu xuất file excel, lọc cột "Thời gian ký nhận" của shipper giao hàng thành công mà trả tiền cho Khách gửi.
Đầu tháng này, bên IT tăng độ khó game, tách cột cần thiết này qua file riêng khác, làm mình dò thủ công mờ cả mắt, chỉ sợ số liệu nhiều làm sai sót trả lộn tiền cho khách thì toi đời, nên mong mọi người giúp đỡ cách xử lý tốt hơn. Cảm ơn mọi người rất rất nhiều!

Mô tả vấn đề:
1) Dựa trên Mã Đơn (cột A) copy "Thời gian ký nhận" (cột L, file dulieu2) tương ứng sang cột trống AH ở file dulieu1
2) Do file dulieu1 và dulieu2, mình xuất và thay thế thường xuyên nên có tác giả nào cho file excel kèm nút đính code VBA có chức năng gộp 2 file thành file dulieu.xlsx thì mình tiện sử dụng hơn.
Đặc điểm 2 file này khi export ra là không thay đổi cấu trúc hoặc thứ tự các cột dữ liệu đều cố định như tệp đính kèm

p/s: nếu yêu cầu nhờ vả có độ khó cao hoặc có gì quá đáng thì mong các bạn bỏ qua, nhu cầu của mình cấp thiết như thế mà cũng không quen bạn nào giỏi code VBA nên mạo muội lập thớt nhờ vả..
Chúc mọi người cuối tuần vui vẻ ^^!

Góp vui.
Bạn tham khảo code này xem sao, hy vọng đúng ý.
Lưu ý đường dẫn của tôi có thể khác của bạn.
Xem file đính kèm và nhấn nút "Chạy code" để có được kết quả.

Option Explicit

Sub ABC()
Dim i&, Lr&, R&, R1&
Dim Arr(), Arr1()
Dim dic As Object, Fso As Object, Key
Dim Ws As Worksheet, Sh As Worksheet, wb As Workbook
Dim File As Variant
Dim Path


With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual

Set Fso = CreateObject("Scripting.FileSystemObject")

Path = ActiveWorkbook.Path
On Error Resume Next
    For Each File In Fso.GetFolder(Path).Files
        If File.Name Like "*dulieu*" Then
            Set wb = Workbooks.Open(File)
            For Each Ws In wb.Worksheets
                If Ws.Name Like "Sheet0" Then
                    Lr = Ws.Cells(Rows.Count, 1).End(xlUp).Row
                    If File.Name Like "*dulieu1*" Then
                        Arr = Ws.Range("A1:AH" & Lr).Value2
                        R = UBound(Arr)
                    Else
                        Arr1 = Ws.Range("A2:L" & Lr).Value2
                        R1 = UBound(Arr1)
                    End If
                End If
            Next Ws
        End If
wb.Close
Next File
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To R
    Key = Arr(i, 1)
        If Not dic.exists(Key) Then
            dic(Key) = i
        Else
            dic(Key) = dic(Key) & "," & i
        End If
Next i
For i = 2 To R1
    Key = Arr1(i, 1)
        If dic.exists(Key) Then
             Arr(dic(Key), 34) = Arr1(i, 12)
        End If
Next i

Set Sh = Sheets("DuLieuTongHop")

    Sh.Range("A1").Resize(10000, UBound(Arr, 2)).ClearContents
    Sh.Range("A1").Resize(R, UBound(Arr, 2)) = Arr
    Sh.Range("A1").Resize(R, UBound(Arr, 2)).EntireColumn.AutoFit

Set dic = Nothing
Set Fso = Nothing
    .ScreenUpdating = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
End With
MsgBox "Done"
End Sub

 

[Sonkull]

Mình dùng Power Query ko phải VBA bạn về bỏ 2 file data vào 1 folder rồi thay đường dẫn file Report (mình tô vàng) đến folder bạn vừa tạo nhé mỗi lần thay file data nguồn Refresh all là được

 

[VetMini]

...
Đầu tháng này, bên IT tăng độ khó game,

"raise the bar", Tây con ạ.

Công ty nào mà IT xía vào dữ liệu quản lý vậy? Công việc của IT là phát triển và bảo trì hạ tầng cơ sở của dữ liệu công ty. Cấu trúc và giá trị dữ liệu thuộc về bên quản lý. Nhất là chuyện bán hàng thuộc về dữ liệu quản lý.

 

[acrox84]

Bạn tham khảo :

Option Explicit

Private Sub CommandButton1_Click()
   
    Dim fso As Object, dic As Object
    Dim sheet As Worksheet, wbOpen As Workbook
    Dim arr As Variant
    Dim sFolderName As String, fileName As String
    Dim i As Long, r As Long
    Dim c As Integer
    Dim bFileOpened As Boolean
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    Application.EnableEvents = False
   
    On Error GoTo End_
   
    Set sheet = ThisWorkbook.ActiveSheet
    sFolderName = sheet.Range("C4")
    fileName = sheet.Range("C8")
    Set fso = CreateObject("Scripting.FileSystemObject")
    GoSub checkBook_
   
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        dic.Item(arr(i, 1)) = arr(i, 12)
    Next i
    If Not bFileOpened Then wbOpen.Close False
    Set wbOpen = Nothing
    fileName = sheet.Range("C6")
    GoSub checkBook_
    r = UBound(arr, 1): c = UBound(arr, 2) + 1
    ReDim Preserve arr(1 To UBound(arr, 1), 1 To c)
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        If dic.Exists(arr(i, 1)) Then
            arr(i, c) = dic.Item(arr(i, 1))
        End If
    Next i
    With wbOpen.Worksheets(1).Range("A1")
        .Resize(r, c) = arr
        .Offset(, c - 1).Resize(r).NumberFormat = "yyyy-mm-dd hh:mm:ss"
    End With
    wbOpen.Save
    If Not bFileOpened Then wbOpen.Close False
    Set wbOpen = Nothing
   
    GoTo End_
   
checkBook_:
    If fso.FileExists(sFolderName & "\" & fileName) Then
        On Error Resume Next
        Set wbOpen = Workbooks(fileName)
        On Error GoTo 0
        If wbOpen Is Nothing Then
            Set wbOpen = Workbooks.Open(sFolderName & "\" & fileName)
            bFileOpened = False
        End If
        arr = wbOpen.Worksheets(1).Range("A1").CurrentRegion.Value
    Else
        MsgBox "Khong tim thay tap tin " & fileName & vbNewLine & _
            " trong thu muc " & sFolderName, vbCritical
        Exit Sub
    End If
   
    Return

End_:

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.EnableEvents = True
   
End Sub

Cảm ơn bạn đã dành thời gian làm cho mình file excel thực thi này, mình cảm thấy rất may mắn vì được bạn giúp đỡ, công việc sắp tới mình khỏe hơn nhiều. Giao diện trực quan, dễ cho newbie như mình chỉnh sửa path, tên file,... code chạy mượt rất mau, một lần nữa cảm ơn bạn^^.

Bài đã được tự động gộp: 9/4/23

Mình dùng Power Query ko phải VBA bạn về bỏ 2 file data vào 1 folder rồi thay đường dẫn file Report (mình tô vàng) đến folder bạn vừa tạo nhé mỗi lần thay file data nguồn Refresh all là được

mình xin phép lưu về để dành, trước giờ chưa xài Power Query này nên không biết test ạ, cảm ơn bạn đã hỗ trợ

Bài đã được tự động gộp: 9/4/23

Góp vui.
Bạn tham khảo code này xem sao, hy vọng đúng ý.
Lưu ý đường dẫn của tôi có thể khác của bạn.
Xem file đính kèm và nhấn nút "Chạy code" để có được kết quả.

Option Explicit

Sub ABC()
Dim i&, Lr&, R&, R1&
Dim Arr(), Arr1()
Dim dic As Object, Fso As Object, Key
Dim Ws As Worksheet, Sh As Worksheet, wb As Workbook
Dim File As Variant
Dim Path


With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual

Set Fso = CreateObject("Scripting.FileSystemObject")

Path = ActiveWorkbook.Path
On Error Resume Next
    For Each File In Fso.GetFolder(Path).Files
        If File.Name Like "*dulieu*" Then
            Set wb = Workbooks.Open(File)
            For Each Ws In wb.Worksheets
                If Ws.Name Like "Sheet0" Then
                    Lr = Ws.Cells(Rows.Count, 1).End(xlUp).Row
                    If File.Name Like "*dulieu1*" Then
                        Arr = Ws.Range("A1:AH" & Lr).Value2
                        R = UBound(Arr)
                    Else
                        Arr1 = Ws.Range("A2:L" & Lr).Value2
                        R1 = UBound(Arr1)
                    End If
                End If
            Next Ws
        End If
wb.Close
Next File
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To R
    Key = Arr(i, 1)
        If Not dic.exists(Key) Then
            dic(Key) = i
        Else
            dic(Key) = dic(Key) & "," & i
        End If
Next i
For i = 2 To R1
    Key = Arr1(i, 1)
        If dic.exists(Key) Then
             Arr(dic(Key), 34) = Arr1(i, 12)
        End If
Next i

Set Sh = Sheets("DuLieuTongHop")

    Sh.Range("A1").Resize(10000, UBound(Arr, 2)).ClearContents
    Sh.Range("A1").Resize(R, UBound(Arr, 2)) = Arr
    Sh.Range("A1").Resize(R, UBound(Arr, 2)).EntireColumn.AutoFit

Set dic = Nothing
Set Fso = Nothing
    .ScreenUpdating = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
End With
MsgBox "Done"
End Sub

bạn có up nhầm file kết quả không ạ, mình mở file lên không thấy nút "Chạy code" đâu cả. Cảm ơn bạn đã code giúp

 

[HUONGHCKT]

Cảm ơn bạn đã dành thời gian làm cho mình file excel thực thi này, mình cảm thấy rất may mắn vì được bạn giúp đỡ, công việc sắp tới mình khỏe hơn nhiều. Giao diện trực quan, dễ cho newbie như mình chỉnh sửa path, tên file,... code chạy mượt rất mau, một lần nữa cảm ơn bạn^^.

Bài đã được tự động gộp: 9/4/23

mình xin phép lưu về để dành, trước giờ chưa xài Power Query này nên không biết test ạ, cảm ơn bạn đã hỗ trợ

Bài đã được tự động gộp: 9/4/23

bạn có up nhầm file kết quả không ạ, mình mở file lên không thấy nút "Chạy code" đâu cả. Cảm ơn bạn đã code giúp

Xin lỗi up nhầm. Nó đây cơ

 

[acrox84]

Xin lỗi up nhầm. Nó đây cơ

Cảm ơn bạn nhiều, mình thử đúng rôi nè

 

[acrox84]

Bạn tham khảo :

Bạn ơi, phát sinh vấn đề nhỏ liên quan đến Format Cell, mình muốn giữ nguyên định dạng Format ô như file gốc.
Như cột A, cột V mình cần Mã vận đơn hiện full số.
+Cột K, cột S là SĐT thì giữ nguyên số 0 ở đầu.

File gốc tải về đã định dạng phù hợp, vấn đề phát sinh sau khi chạy gộp file, bạn hỗ trợ giúp mình với.

 

[Hoàng Nhật Phương]

Bạn ơi, phát sinh vấn đề nhỏ liên quan đến Format Cell, mình muốn giữ nguyên định dạng Format ô như file gốc.
Như cột A, cột V mình cần Mã vận đơn hiện full số.
+Cột K, cột S là SĐT thì giữ nguyên số 0 ở đầu.

File gốc tải về đã định dạng phù hợp, vấn đề phát sinh sau khi chạy gộp file, bạn hỗ trợ giúp mình với.


View attachment 288709

Bạn thử lại . . :

Option Explicit

Sub getSpeed(ByVal bl As Boolean)
    With Application
        .EnableEvents = Not bl
        .ScreenUpdating = Not bl
        .Calculation = IIf(bl, xlCalculationManual, xlCalculationAutomatic)
    End With
End Sub

Private Sub CommandButton1_Click()
    
    Dim fso As Object, dic As Object
    Dim sheet As Worksheet, wbOpen As Workbook, cell As Range
    Dim arr As Variant, result() As String
    Dim sFolderName As String, fileName As String, capnhat As String
    Dim i As Long, r As Long
    Dim c As Integer
    Dim bFileOpened As Boolean
    capnhat = "C" & ChrW(7853) & "p nh" & ChrW(7853) & "t l" & ChrW(250) & "c:"

    getSpeed True
    
    On Error GoTo End_
    
    Set sheet = ThisWorkbook.ActiveSheet
    sFolderName = sheet.Range("C4")
    fileName = sheet.Range("C8")
    Set fso = CreateObject("Scripting.FileSystemObject")
    GoSub checkBook_
    
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        dic.Item(arr(i, 1)) = arr(i, 12)
    Next i
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    fileName = sheet.Range("C6")
    GoSub checkBook_
    r = UBound(arr, 1): c = UBound(arr, 2)
    ReDim result(1 To UBound(arr, 1), 1 To 1)
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        If dic.Exists(arr(i, 1)) Then
            result(i, 1) = dic.Item(arr(i, 1))
        End If
    Next i
    result(1, 1) = capnhat & Format(Now, "yyyy/dd/mm -hh:mm:ss")
    wbOpen.Worksheets(1).Range("A1").Offset(, c).Resize(r) = result
    wbOpen.Save
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    MsgBox "Xong rùi nha !", vbInformation + vbOKOnly
    GoTo End_
    
checkBook_:
    If fso.FileExists(sFolderName & "\" & fileName) Then
        On Error Resume Next
        Set wbOpen = Workbooks(fileName)
        On Error GoTo 0
        If wbOpen Is Nothing Then
            Set wbOpen = Workbooks.Open(sFolderName & "\" & fileName)
            bFileOpened = False
        End If
        arr = wbOpen.Worksheets(1).Range("A1").CurrentRegion.Value2
    Else
        MsgBox "Khong tim thay tap tin " & fileName & vbNewLine & _
            " trong thu muc " & sFolderName, vbCritical
        GoTo End_
    End If
    Return

End_:
    getSpeed False
    
End Sub

 

[Hoàng Nhật Phương]

Bạn thử lại . . :

Option Explicit

Sub getSpeed(ByVal bl As Boolean)
    With Application
        .EnableEvents = Not bl
        .ScreenUpdating = Not bl
        .Calculation = IIf(bl, xlCalculationManual, xlCalculationAutomatic)
    End With
End Sub

Private Sub CommandButton1_Click()
   
    Dim fso As Object, dic As Object
    Dim sheet As Worksheet, wbOpen As Workbook, cell As Range
    Dim arr As Variant, result() As String
    Dim sFolderName As String, fileName As String, capnhat As String
    Dim i As Long, r As Long
    Dim c As Integer
    Dim bFileOpened As Boolean
    capnhat = "C" & ChrW(7853) & "p nh" & ChrW(7853) & "t l" & ChrW(250) & "c:"

    getSpeed True
   
    On Error GoTo End_
   
    Set sheet = ThisWorkbook.ActiveSheet
    sFolderName = sheet.Range("C4")
    fileName = sheet.Range("C8")
    Set fso = CreateObject("Scripting.FileSystemObject")
    GoSub checkBook_
   
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        dic.Item(arr(i, 1)) = arr(i, 12)
    Next i
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    fileName = sheet.Range("C6")
    GoSub checkBook_
    r = UBound(arr, 1): c = UBound(arr, 2)
    ReDim result(1 To UBound(arr, 1), 1 To 1)
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        If dic.Exists(arr(i, 1)) Then
            result(i, 1) = dic.Item(arr(i, 1))
        End If
    Next i
    result(1, 1) = capnhat & Format(Now, "yyyy/dd/mm -hh:mm:ss")
    wbOpen.Worksheets(1).Range("A1").Offset(, c).Resize(r) = result
    wbOpen.Save
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    MsgBox "Xong rùi nha !", vbInformation + vbOKOnly
    GoTo End_
   
checkBook_:
    If fso.FileExists(sFolderName & "\" & fileName) Then
        On Error Resume Next
        Set wbOpen = Workbooks(fileName)
        On Error GoTo 0
        If wbOpen Is Nothing Then
            Set wbOpen = Workbooks.Open(sFolderName & "\" & fileName)
            bFileOpened = False
        End If
        arr = wbOpen.Worksheets(1).Range("A1").CurrentRegion.Value2
    Else
        MsgBox "Khong tim thay tap tin " & fileName & vbNewLine & _
            " trong thu muc " & sFolderName, vbCritical
        GoTo End_
    End If
    Return

End_:
    getSpeed False
   
End Sub

Với code trên mình sửa lại:
Nếu file mới chưa cập nhật lần nào kết quả sẽ đưa vào cột AH, nếu cập nhật lần tiếp theo (không phải file mới) kết quả sẽ đưa vào cột AI. tại dòng đầu mỗi lần cập nhật cũng sẽ ghi thời điểm cập nhật nhé bạn.

 

[acrox84]

Với code trên mình sửa lại:
Nếu file mới chưa cập nhật lần nào kết quả sẽ đưa vào cột AH, nếu cập nhật lần tiếp theo (không phải file mới) kết quả sẽ đưa vào cột AI. tại dòng đầu mỗi lần cập nhật cũng sẽ ghi thời điểm cập nhật nhé bạn.

chuẩn rồi bạn, tối nay mình mới thử xong, quá đã thanksyou!

 

[acrox84]

Option Explicit

_Phiền bạn chút, công việc cuối ngày mình là tổng hợp đơn, phân loại rồi gửi khách kiểm tra lại. Mình có 2 tài khoản đổ file ra, trước đây nó xuất ra theo thứ tự cột giống hệt nhau nên mình Copy tay hết dòng dữ liệu rồi Paste ra là xong.

Giờ không hiểu sao Tài khoản 2 đổ ra thứ tự khác nhiều cột so với Tài khoản 1, mình tìm cách chỉnh cài đặt các thứ vẫn không được, cài lại trình duyệt Chorme, Firefox, Edge các thứ cũng không được.

_Mình nhớ tới bạn từng giúp thiết kế file chức năng gộp tương tự nên lại lên nhờ vả, mong bạn giúp thêm 1 file gộp này.

*Mình cần chép toàn bộ data file dulieu2 sang dulieu, mỗi file có thể tối đa 1000 dòng. Các tiêu đề 2 file đều giống hệt nhau, chỉ có thứ tự sắp xếp là khác (cái thứ tự khác này là cố định, chứ không phải mỗi lần đổ file ra là random)

*File gốc dulieu làm chuẩn, chép thêm dulieu2 qua là xong (trong file đính kèm là từ dòng 41, chép thêm 5 dòng nữa, cần đúng cột & định dạng ô)
Chân Thành Cảm Ơn!!

 

[Hoàng Nhật Phương]

_Phiền bạn chút, công việc cuối ngày mình là tổng hợp đơn, phân loại rồi gửi khách kiểm tra lại. Mình có 2 tài khoản đổ file ra, trước đây nó xuất ra theo thứ tự cột giống hệt nhau nên mình Copy tay hết dòng dữ liệu rồi Paste ra là xong.

Giờ không hiểu sao Tài khoản 2 đổ ra thứ tự khác nhiều cột so với Tài khoản 1, mình tìm cách chỉnh cài đặt các thứ vẫn không được, cài lại trình duyệt Chorme, Firefox, Edge các thứ cũng không được.

_Mình nhớ tới bạn từng giúp thiết kế file chức năng gộp tương tự nên lại lên nhờ vả, mong bạn giúp thêm 1 file gộp này.

*Mình cần chép toàn bộ data file dulieu2 sang dulieu, mỗi file có thể tối đa 1000 dòng. Các tiêu đề 2 file đều giống hệt nhau, chỉ có thứ tự sắp xếp là khác (cái thứ tự khác này là cố định, chứ không phải mỗi lần đổ file ra là random)

*File gốc dulieu làm chuẩn, chép thêm dulieu2 qua là xong (trong file đính kèm là từ dòng 41, chép thêm 5 dòng nữa, cần đúng cột & định dạng ô)
Chân Thành Cảm Ơn!!

Mình đọc nhưng chưa hiểu ý bạn.
Có phải vấn đề lần này không giống vấn đề lần trước.

Các tiêu đề 2 file đều giống hệt nhau,

Mình có thấy giống đâu nhỉ:



Nếu chỉ là :

cần chép toàn bộ data file dulieu2 sang dulieu

Thì điều kiện để copy đưa sang là thế nào vậy bạn , có so sánh những cột nào giống nhau rồi thì đưa sang nữa không?

 

[acrox84]

Mình đọc nhưng chưa hiểu ý bạn.
Có phải vấn đề lần này không giống vấn đề lần trước.

Mình có thấy giống đâu nhỉ:

View attachment 290228

Nếu chỉ là :

Thì điều kiện để copy đưa sang là thế nào vậy bạn , có so sánh những cột nào giống nhau rồi thì đưa sang nữa không?

Đúng rồi bạn, so sánh tiêu đề cột giống nhau thì copy sang, lấy file dulieu.xlsx làm gốc
--> 2 file này có 33 cột dữ liệu có tiêu đề hoàn toàn giống nhau, nhưng thứ tự sắp xếp khác nhau, nên mình không copy & paste bình thường được.

 

[Hoàng Nhật Phương]

Đúng rồi bạn, so sánh tiêu đề cột giống nhau thì copy sang, lấy file dulieu.xlsx làm gốc
--> 2 file này có 33 cột dữ liệu có tiêu đề hoàn toàn giống nhau, nhưng thứ tự sắp xếp khác nhau, nên mình không copy & paste bình thường được.

Chào bạn, có nhiều cô giống nhau ở 2 file nhưng thứ tự khác nhau và copy các cột giống nhau thì mình hiểu.
Vấn đề là điều kiện copy là như thế nào ví dụ trùng mã đơn hàng thì thôi không copy nữa hoặc trùng mã nhưng dữ liệu cột khác mà khác thì copy v.v... hay là trùng rồi thì cứ copy tiếp chèn xuống dưới?

 

[acrox84]

Chào bạn, có nhiều cô giống nhau ở 2 file nhưng thứ tự khác nhau và copy các cột giống nhau thì mình hiểu.
Vấn đề là điều kiện copy là như thế nào ví dụ trùng mã đơn hàng thì thôi không copy nữa hoặc trùng mã nhưng dữ liệu cột khác mà khác thì copy v.v... hay là trùng rồi thì cứ copy tiếp chèn xuống dưới?

Kiểu gộp dữ liệu 2 file lại thành một, sau đó mình lấy file dulieu.xlsx này xử lý tiếp.
Bạn xem clip mô tả này giúp mình. Trước đây 2 file này cùng thứ tự cột thì mình hay copy - paste như vậy rồi save file dulieu.xlsx lại là xong. Giờ file dulieu2 này đảo lộn thứ tự cột nên mình không làm được như vậy nữa.

Liên kết: https://www.youtube.com/watch?v=_JkkXf8s6T8

 

[ngocbaovu]

Kiểu gộp dữ liệu 2 file lại thành một, sau đó mình lấy file dulieu.xlsx này xử lý tiếp.

Việc copy sắp xếp lại dữ liệu theo form file dulieu thì không vấn đề gì. Có điều là có cần kiểm tra "Mã vận đơn" trong file dulieu2 đã tồn tại trong file dulieu chưa? Nếu đã có thì có copy không? nếu copy thì có xử lý dữ liệu đã tồn tại trong file dulieu không?

 

[acrox84]

Việc copy sắp xếp lại dữ liệu theo form file dulieu thì không vấn đề gì. Có điều là có cần kiểm tra "Mã vận đơn" trong file dulieu2 đã tồn tại trong file dulieu chưa? Nếu đã có thì có copy không? nếu copy thì có xử lý dữ liệu đã tồn tại trong file dulieu không?

Không phải kiểm tra ạ, do 2 file này độc lập nhau, là 2 tài khoản của 2 khách hàng khác nhau lên đơn nên mã vận đơn các thứ khác nhau hoàn toàn.
Do cuối ngày phải gộp toàn bộ dữ liệu lại để kế toán tính xem được bao nhiêu đơn, thu bao nhiêu tiền tổng cộng,...

 

[Hoàng Nhật Phương]

Không phải kiểm tra ạ, do 2 file này độc lập nhau, là 2 tài khoản của 2 khách hàng khác nhau lên đơn nên mã vận đơn các thứ khác nhau hoàn toàn.
Do cuối ngày phải gộp toàn bộ dữ liệu lại để kế toán tính xem được bao nhiêu đơn, thu bao nhiêu tiền tổng cộng,...

Option Explicit

Sub getSpeed(ByVal bl As Boolean)
    With Application
        .EnableEvents = Not bl
        .ScreenUpdating = Not bl
        .Calculation = IIf(bl, xlCalculationManual, xlCalculationAutomatic)
    End With
End Sub

Private Sub CommandButton1_Click()
    
    Dim wbA As Workbook, wbB As Workbook, wsA As Worksheet, wsB As Worksheet, colA As Range, colB As Range
    Dim lastRowA As Long, lastRowB As Long, lastColA As Long, lastColB As Long
    Dim colTitleA As String, colTitleB As String, sFileNameA As String, sFileNameB As String
    
    getSpeed True
    
    On Error GoTo End_
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    sFileNameA = Me.Range("C4").Value & "\" & Me.Range("C6").Value
    sFileNameB = Me.Range("C4").Value & "\" & Me.Range("C8").Value
    If (Not fso.FileExists(sFileNameA)) Or (Not fso.FileExists(sFileNameA)) Then
        MsgBox "Khong tim thay tap tin trong thu muc chi dinh.", vbCritical
        GoTo End_
    End If
    
    Set wbA = Workbooks.Open(sFileNameA):   Set wsA = wbA.Worksheets(1)
    Set wbB = Workbooks.Open(sFileNameB):   Set wsB = wbB.Worksheets(1)
    
    lastRowA = wsA.Cells(wsA.Rows.Count, 1).End(xlUp).Row
    lastColA = wsA.Cells(1, wsA.Columns.Count).End(xlToLeft).Column
    lastRowB = wsB.Cells(wsB.Rows.Count, 1).End(xlUp).Row
    lastColB = wsB.Cells(1, wsB.Columns.Count).End(xlToLeft).Column
    
    For Each colB In wsB.Range(wsB.Cells(1, 1), wsB.Cells(1, lastColB)).Columns
        colTitleB = colB.Cells(1).Value
        Set colA = wsA.Rows(1).Find(colTitleB, LookIn:=xlValues, LookAt:=xlWhole)
        If Not colA Is Nothing Then
            lastRowA = wsA.Cells(wsA.Rows.Count, colA.Column).End(xlUp).Row
            wsB.Range(colB.Cells(2), colB.Cells(lastRowB)).Copy _
                Destination:=wsA.Cells(lastRowA + 1, colA.Column)
        End If
    Next colB
    
    wbB.Close SaveChanges:=False
    wbA.Save:   wbA.Close SaveChanges:=False
    
    MsgBox "Xong rùi nha !", vbInformation + vbOKOnly

End_:
    getSpeed False
    
End Sub

Bạn chạy chức năng trong sheet2 rồi kiểm tra lại.
Mỗi lần chạy chức năng là dữ liệu lại copy tiếp xuống dưới không xác định trùng lặp.

 

[acrox84]

Option Explicit

Sub getSpeed(ByVal bl As Boolean)
    With Application
        .EnableEvents = Not bl
        .ScreenUpdating = Not bl
        .Calculation = IIf(bl, xlCalculationManual, xlCalculationAutomatic)
    End With
End Sub

Private Sub CommandButton1_Click()
   
    Dim wbA As Workbook, wbB As Workbook, wsA As Worksheet, wsB As Worksheet, colA As Range, colB As Range
    Dim lastRowA As Long, lastRowB As Long, lastColA As Long, lastColB As Long
    Dim colTitleA As String, colTitleB As String, sFileNameA As String, sFileNameB As String
   
    getSpeed True
   
    On Error GoTo End_
   
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    sFileNameA = Me.Range("C4").Value & "\" & Me.Range("C6").Value
    sFileNameB = Me.Range("C4").Value & "\" & Me.Range("C8").Value
    If (Not fso.FileExists(sFileNameA)) Or (Not fso.FileExists(sFileNameA)) Then
        MsgBox "Khong tim thay tap tin trong thu muc chi dinh.", vbCritical
        GoTo End_
    End If
   
    Set wbA = Workbooks.Open(sFileNameA):   Set wsA = wbA.Worksheets(1)
    Set wbB = Workbooks.Open(sFileNameB):   Set wsB = wbB.Worksheets(1)
   
    lastRowA = wsA.Cells(wsA.Rows.Count, 1).End(xlUp).Row
    lastColA = wsA.Cells(1, wsA.Columns.Count).End(xlToLeft).Column
    lastRowB = wsB.Cells(wsB.Rows.Count, 1).End(xlUp).Row
    lastColB = wsB.Cells(1, wsB.Columns.Count).End(xlToLeft).Column
   
    For Each colB In wsB.Range(wsB.Cells(1, 1), wsB.Cells(1, lastColB)).Columns
        colTitleB = colB.Cells(1).Value
        Set colA = wsA.Rows(1).Find(colTitleB, LookIn:=xlValues, LookAt:=xlWhole)
        If Not colA Is Nothing Then
            lastRowA = wsA.Cells(wsA.Rows.Count, colA.Column).End(xlUp).Row
            wsB.Range(colB.Cells(2), colB.Cells(lastRowB)).Copy _
                Destination:=wsA.Cells(lastRowA + 1, colA.Column)
        End If
    Next colB
   
    wbB.Close SaveChanges:=False
    wbA.Save:   wbA.Close SaveChanges:=False
   
    MsgBox "Xong rùi nha !", vbInformation + vbOKOnly

End_:
    getSpeed False
   
End Sub

Bạn chạy chức năng trong sheet2 rồi kiểm tra lại.
Mỗi lần chạy chức năng là dữ liệu lại copy tiếp xuống dưới không xác định trùng lặp.

Done!
Cảm ơn bạn lần nữa đã giải quyết vấn đề giúp mình, mình mới tets thử rất hoàn chỉnh và chính xác.

 

[Hoàng Nhật Phương]

Done!
Cảm ơn bạn lần nữa đã giải quyết vấn đề giúp mình, mình mới tets thử rất hoàn chỉnh và chính xác.

Bạn,thử lại đoạn này để giảm rủi do trùng lặp do bấm nhầm vậy.
Mình đã tạo thêm 1 thư mục "copy_OK" để lưu dữ liệu nguồn,sau khi đã thực hiện chuyển dữ liệu sang:

Option Explicit

Private Sub CommandButton1_Click()

    Dim wbA As Workbook, wbB As Workbook, wsA As Worksheet, wsB As Worksheet, colA As Range, colB As Range
    Dim lastRowA As Long, lastRowB As Long, lastColA As Long, lastColB As Long
    Dim colTitleA As String, colTitleB As String, sFileNameA As String, sFileNameB As String
    Dim sErr As String, copyFolderPath As String, sFolder As String, newFileName As String
    Dim fso As Object, dataExists As Boolean

    Set fso = CreateObject("Scripting.FileSystemObject")
    sFolder = Me.Range("C4").Value
    If Not fso.FolderExists(sFolder) Then
        MsgBox "Khong tim thay thu muc: " & vbNewLine & sFolder, vbCritical
        GoTo End_
    End If
    
    sFileNameA = sFolder & "\" & Me.Range("C6").Value
    sFileNameB = sFolder & "\" & Me.Range("C8").Value
    
    If Not fso.FileExists(sFileNameA) Then sErr = sFileNameA
    If Not fso.FileExists(sFileNameB) Then sErr = sFileNameB
    
    If Len(sErr) > 0 Then
        MsgBox "Khong tim thay tap tin: " & vbNewLine & sErr, vbCritical
        GoTo End_
    End If
    
    Set wbA = Workbooks.Open(sFileNameA): Set wsA = wbA.Worksheets(1)
    Set wbB = Workbooks.Open(sFileNameB): Set wsB = wbB.Worksheets(1)
    lastRowA = wsA.Cells(wsA.Rows.Count, 1).End(xlUp).Row
    lastColA = wsA.Cells(1, wsA.Columns.Count).End(xlToLeft).Column
    lastRowB = wsB.Cells(wsB.Rows.Count, 1).End(xlUp).Row
    lastColB = wsB.Cells(1, wsB.Columns.Count).End(xlToLeft).Column
    
    For Each colB In wsB.Range(wsB.Cells(1, 1), wsB.Cells(1, lastColB)).Columns
        colTitleB = colB.Cells(1).Value
        Set colA = wsA.Rows(1).Find(colTitleB, LookIn:=xlValues, LookAt:=xlWhole)
        If Not colA Is Nothing Then
            dataExists = Not IsError(Application.Match(colB.Cells(2).Value, wsA.Range(colA.Offset(1), wsA.Cells(lastRowA, colA.Column)), 0))
            If Not dataExists Then
                lastRowA = wsA.Cells(wsA.Rows.Count, colA.Column).End(xlUp).Row
                wsB.Range(colB.Cells(2), colB.Cells(lastRowB)).Copy Destination:=wsA.Cells(lastRowA + 1, colA.Column)
            End If
        End If
    Next colB
    
    wbB.Close SaveChanges:=False:   wbA.Save:   wbA.Close SaveChanges:=False
    copyFolderPath = sFolder & "\copy_OK"
    If Not fso.FolderExists(copyFolderPath) Then fso.CreateFolder copyFolderPath
    
    If fso.FolderExists(copyFolderPath) Then
        newFileName = "copy__OK__" & Format(Now, "yymmddhhmmss") & ".xlsx"
        fso.MoveFile sFileNameB, copyFolderPath & "\" & newFileName
    End If

End_:
    getSpeed False

End Sub

 

[acrox84]

Bạn,thử lại đoạn này để giảm rủi do trùng lặp do bấm nhầm vậy.
Mình đã tạo thêm 1 thư mục "copy_OK" để lưu dữ liệu nguồn,sau khi đã thực hiện chuyển dữ liệu sang:

Option Explicit

Private Sub CommandButton1_Click()

    Dim wbA As Workbook, wbB As Workbook, wsA As Worksheet, wsB As Worksheet, colA As Range, colB As Range
    Dim lastRowA As Long, lastRowB As Long, lastColA As Long, lastColB As Long
    Dim colTitleA As String, colTitleB As String, sFileNameA As String, sFileNameB As String
    Dim sErr As String, copyFolderPath As String, sFolder As String, newFileName As String
    Dim fso As Object, dataExists As Boolean

    Set fso = CreateObject("Scripting.FileSystemObject")
    sFolder = Me.Range("C4").Value
    If Not fso.FolderExists(sFolder) Then
        MsgBox "Khong tim thay thu muc: " & vbNewLine & sFolder, vbCritical
        GoTo End_
    End If
   
    sFileNameA = sFolder & "\" & Me.Range("C6").Value
    sFileNameB = sFolder & "\" & Me.Range("C8").Value
   
    If Not fso.FileExists(sFileNameA) Then sErr = sFileNameA
    If Not fso.FileExists(sFileNameB) Then sErr = sFileNameB
   
    If Len(sErr) > 0 Then
        MsgBox "Khong tim thay tap tin: " & vbNewLine & sErr, vbCritical
        GoTo End_
    End If
   
    Set wbA = Workbooks.Open(sFileNameA): Set wsA = wbA.Worksheets(1)
    Set wbB = Workbooks.Open(sFileNameB): Set wsB = wbB.Worksheets(1)
    lastRowA = wsA.Cells(wsA.Rows.Count, 1).End(xlUp).Row
    lastColA = wsA.Cells(1, wsA.Columns.Count).End(xlToLeft).Column
    lastRowB = wsB.Cells(wsB.Rows.Count, 1).End(xlUp).Row
    lastColB = wsB.Cells(1, wsB.Columns.Count).End(xlToLeft).Column
   
    For Each colB In wsB.Range(wsB.Cells(1, 1), wsB.Cells(1, lastColB)).Columns
        colTitleB = colB.Cells(1).Value
        Set colA = wsA.Rows(1).Find(colTitleB, LookIn:=xlValues, LookAt:=xlWhole)
        If Not colA Is Nothing Then
            dataExists = Not IsError(Application.Match(colB.Cells(2).Value, wsA.Range(colA.Offset(1), wsA.Cells(lastRowA, colA.Column)), 0))
            If Not dataExists Then
                lastRowA = wsA.Cells(wsA.Rows.Count, colA.Column).End(xlUp).Row
                wsB.Range(colB.Cells(2), colB.Cells(lastRowB)).Copy Destination:=wsA.Cells(lastRowA + 1, colA.Column)
            End If
        End If
    Next colB
   
    wbB.Close SaveChanges:=False:   wbA.Save:   wbA.Close SaveChanges:=False
    copyFolderPath = sFolder & "\copy_OK"
    If Not fso.FolderExists(copyFolderPath) Then fso.CreateFolder copyFolderPath
   
    If fso.FolderExists(copyFolderPath) Then
        newFileName = "copy__OK__" & Format(Now, "yymmddhhmmss") & ".xlsx"
        fso.MoveFile sFileNameB, copyFolderPath & "\" & newFileName
    End If

End_:
    getSpeed False

End Sub

Mình thử gộp thêm vài loại file excel có nhiều cột khác nhau, thì file VBA của bạn đều gộp dữ liệu tốt, tính ứng dụng cho nhiều mục đích của những bạn khác cũng xài lại đc, không riêng gì mình.
Cho hỏi bài này có giới hạn bao nhiêu dòng dữ liệu ở mỗi file không ạ

 

[acrox84]

Bạn,thử lại đoạn này để giảm rủi do trùng lặp do bấm nhầm vậy.
Mình đã tạo thêm 1 thư mục "copy_OK" để lưu dữ liệu nguồn,sau khi đã thực hiện chuyển dữ liệu sang:

Cái chức năng tạo thêm thư mục backup file mình chưa cần.
Nếu có thể, bạn sửa lại ntn mà không chép đè lên file dulieu thì mình có thể kiểm tra lại nguồn dulieu1 và dulieu2.
Tức là cùng thư mục có dulieu1 và dulieu2, bấm nút chạy code VBA sẽ ra file mới dulieu.xlsx và không xóa dulieu1 và dulieu2.
Cảm ơn bạn rất nhiều!

 

[Hoàng Nhật Phương]

Cái chức năng tạo thêm thư mục backup file mình chưa cần.
Nếu có thể, bạn sửa lại ntn mà không chép đè lên file dulieu thì mình có thể kiểm tra lại nguồn dulieu1 và dulieu2.
Tức là cùng thư mục có dulieu1 và dulieu2, bấm nút chạy code VBA sẽ ra file mới dulieu.xlsx và không xóa dulieu1 và dulieu2.
Cảm ơn bạn rất nhiều!

View attachment 290261

Bạn chạy chức năng trong sheet3:

Option Explicit

Private Sub CommandButton1_Click()

    Dim wb As Workbook, wbNew As Workbook, ws As Worksheet, wsNew As Worksheet, col As Range, colNew As Range
    Dim lastRow As Long, lastCol As Long, lastRowNew As Long
    Dim colTitle As String, sFolder As String, newFileName As String, filePath As String
    Dim fso As Object, fileNames As Variant, fileName As Variant
    
    getSpeed True
    On Error GoTo End_
    Set fso = CreateObject("Scripting.FileSystemObject")
    sFolder = Me.Range("C4").Value
    
    If Not fso.FolderExists(sFolder) Then
        MsgBox "Khong tim thay thu muc: " & vbNewLine & sFolder, vbCritical
        GoTo End_
    End If
    fileNames = Split(Me.Range("C6").Value, ";")
    Set wbNew = Workbooks.Add:  Set wsNew = wbNew.Worksheets(1)
    lastRowNew = 1
    For Each fileName In fileNames
        filePath = sFolder & "\" & fileName
        If Not fso.FileExists(filePath) Then
            MsgBox "Khong tim thay tap tin: " & vbNewLine & filePath, vbCritical
            GoTo End_
        End If
        Set wb = Workbooks.Open(filePath):  Set ws = wb.Worksheets(1)
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        If lastRowNew = 1 Then
            ws.UsedRange.Copy Destination:=wsNew.Cells(lastRowNew, 1)
            lastRowNew = lastRow
        Else
            For Each col In ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol))
                colTitle = col.Cells(1).Value
                Set colNew = wsNew.Rows(1).Find(colTitle, LookIn:=xlValues, LookAt:=xlWhole)
                If Not colNew Is Nothing Then
                    ws.Range(col.Cells(2), col.Cells(lastRow)).Copy Destination:=wsNew.Cells(wsNew.Cells(wsNew.Rows.Count, colNew.Column).End(xlUp).Row + 1, colNew.Column)
                End If
            Next col
            lastRowNew = lastRowNew + lastRow - 1
        End If
        wb.Close SaveChanges:=False
    Next fileName
    
    newFileName = "merged_data_" & Format(Now, "yyyyMMdd_hhmmss") & ".xlsx"
    wbNew.SaveAs sFolder & "\" & newFileName
    wbNew.Close SaveChanges:=False
    MsgBox "Xong rùi nha, file moi duoc luu toi :" & vbNewLine & sFolder & "\" & newFileName, vbInformation

End_:
    getSpeed False
    
End Sub

Mình thử gộp thêm vài loại file excel có nhiều cột khác nhau, thì file VBA của bạn đều gộp dữ liệu tốt, tính ứng dụng cho nhiều mục đích của những bạn khác cũng xài lại đc, không riêng gì mình.
Cho hỏi bài này có giới hạn bao nhiêu dòng dữ liệu ở mỗi file không ạ

Hihi tất nhiên là có chứ bạn, excel của bạn có bao nhiêu dòng bao nhiêu cột thì code giới hạn chừng đó.

 

[acrox84]

Bạn chạy chức năng trong sheet3:

Option Explicit

Private Sub CommandButton1_Click()

    Dim wb As Workbook, wbNew As Workbook, ws As Worksheet, wsNew As Worksheet, col As Range, colNew As Range
    Dim lastRow As Long, lastCol As Long, lastRowNew As Long
    Dim colTitle As String, sFolder As String, newFileName As String, filePath As String
    Dim fso As Object, fileNames As Variant, fileName As Variant
   
    getSpeed True
    On Error GoTo End_
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    sFolder = Me.Range("C4").Value
    If Not fso.FolderExists(sFolder) Then
        MsgBox "Khong tim thay thu muc: " & vbNewLine & sFolder, vbCritical
        GoTo End_
    End If
    fileNames = Split(Me.Range("C6").Value, ";")
    Set wbNew = Workbooks.Add:  Set wsNew = wbNew.Worksheets(1)
    lastRowNew = 1
   
    For Each fileName In fileNames
        filePath = sFolder & "\" & fileName
        If Not fso.FileExists(filePath) Then
            MsgBox "Khong tim thay tap tin: " & vbNewLine & filePath, vbCritical
            GoTo End_
        End If
        Set wb = Workbooks.Open(filePath):  Set ws = wb.Worksheets(1)
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        ws.Range("A1").CurrentRegion.Copy Destination:=wsNew.Cells(lastRowNew, 1)
        lastRowNew = lastRowNew + lastRow
        wb.Close SaveChanges:=False
    Next fileName
   
    newFileName = "merged_data_" & Format(Now, "yyyyMMdd_hhmmss") & ".xlsx"
    wbNew.SaveAs sFolder & "\" & newFileName
    wbNew.Close SaveChanges:=False
    MsgBox "Xong rùi nha, file moi duoc luu toi :" & vbNewLine & sFolder & "\" & newFileName, vbInformation

End_:
    getSpeed False
   
End Sub

Hihi tất nhiên là có chứ bạn, excel của bạn có bao nhiêu dòng bao nhiêu cột thì code giới hạn chừng đó.

Tools này có chức năng gộp cơ bản, mà không có yêu cầu như tool ở sheet 2 của mình.
Mình vẫn cần chức năng giữ nguyên form cột ở file đầu tiên (trường hợp này tên cố định là dulieu1) và bỏ dòng tiêu đề khi gộp.

 

[Hoàng Nhật Phương]

Tools này có chức năng gộp cơ bản, mà không có yêu cầu như tool ở sheet 2 của mình.
Mình vẫn cần chức năng giữ nguyên form cột ở file đầu tiên (trường hợp này tên cố định là dulieu1) và bỏ dòng tiêu đề khi gộp.

View attachment 290288

Xin lỗi, khi nãy sửa code để rút gọn mình xóa hơi quá tay vì không nghĩ đến vấn đề 2 file có dữ liệu các cột khác nhau.
Mình đã sửa lại code bài trên (bài 25) và đính kèm lại file.
Bạn kiểm tra lại.

 

[acrox84]

Xin lỗi, khi nãy sửa code để rút gọn mình xóa hơi quá tay vì không nghĩ đến vấn đề 2 file có dữ liệu các cột khác nhau.
Mình đã sửa lại code bài trên (bài 25) và đính kèm lại file.
Bạn kiểm tra lại.

Hoàn thiện toàn bộ nhu cầu của mình rồi, nãy giờ mãi mê thử file Tools mới này.
Cảm ơn bạn Hoàng Nhật Phương rất rất nhiều, với Tools bạn viết mỗi ngày mình sẽ đều sử dụng, nó giúp mình tiết kiệm thời gian và yên tâm không sợ sai sót khi copy tay bị nhầm nữa!

 

[acrox84]

Option Explicit
Sub getSpeed(ByVal bl As Boolean)
With Application
.EnableEvents = Not bl
.ScreenUpdating = Not bl
.Calculation = IIf(bl, xlCalculationManual, xlCalculationAutomatic)
End With
End Sub

Private Sub CommandButton1_Click()

Dim fso As Object, dic As Object
Dim sheet As Worksheet, wbOpen As Workbook, cell As Range
Dim arr As Variant, result() As String
Dim sFolderName As String, fileName As String
Dim i As Long, r As Long
Dim c As Integer
Dim bFileOpened As Boolean

getSpeed True

On Error GoTo End_

Set sheet = ThisWorkbook.ActiveSheet
sFolderName = sheet.Range("C4")
fileName = sheet.Range("C8")
Set fso = CreateObject("Scripting.FileSystemObject")
GoSub checkBook_

Set dic = CreateObject("Scripting.Dictionary")
For i = LBound(arr, 1) + 1 To UBound(arr, 1)
dic.Item(arr(i, 1)) = arr(i, 12)
Next i
If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
fileName = sheet.Range("C6")
GoSub checkBook_
r = UBound(arr, 1): c = UBound(arr, 2)
ReDim result(1 To UBound(arr, 1), 1 To 1)
For i = LBound(arr, 1) + 1 To UBound(arr, 1)
If dic.Exists(arr(i, 1)) Then
result(i, 1) = dic.Item(arr(i, 1))
End If
Next i
wbOpen.Worksheets(1).Range("A1").Offset(, c).Resize(r) = result
wbOpen.Save
If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
MsgBox "BC MINH: Ghep KyNhan xong!", vbInformation + vbOKOnly
GoTo End_

checkBook_:
If fso.FileExists(sFolderName & "\" & fileName) Then
On Error Resume Next
Set wbOpen = Workbooks(fileName)
On Error GoTo 0
If wbOpen Is Nothing Then
Set wbOpen = Workbooks.Open(sFolderName & "\" & fileName)
bFileOpened = False
End If
arr = wbOpen.Worksheets(1).Range("A1").CurrentRegion.Value2
Else
MsgBox "Khong tim thay tap tin " & fileName & vbNewLine & _
" trong thu muc " & sFolderName, vbCritical
GoTo End_
End If
Return

End_:
getSpeed False

End Sub

Bạn Hoàng Nhật Phương giúp mình chỉnh code file này lại với, code này lúc trước bạn viết giúp:
+Đối chiếu cột Mã vận đơn (cột có thứ tự là 1) để ghép cột Thời gian ký nhận (cột có thứ tự là 12)
-->giờ cột Mã vận đơn đổi ở vị trí thứ tự là 2 thì mình sửa code trên ở những chỗ nào vậy?

+Bạn giúp mình Bổ sung thêm: Cũng điều kiện trên, dựa trên cột Mã vận đơn có số thứ tự cột là 2, đồng thời chép cột Thời gian ký nhận (số cột 12) và chép thêm cột Tỉnh (số cột 19)

*Chân thành cảm ơn bạn rất nhiều!

 

[Hoàng Nhật Phương]

Bạn Hoàng Nhật Phương giúp mình chỉnh code file này lại với, code này lúc trước bạn viết giúp:
+Đối chiếu cột Mã vận đơn (cột có thứ tự là 1) để ghép cột Thời gian ký nhận (cột có thứ tự là 12)
-->giờ cột Mã vận đơn đổi ở vị trí thứ tự là 2 thì mình sửa code trên ở những chỗ nào vậy?

+Bạn giúp mình Bổ sung thêm: Cũng điều kiện trên, dựa trên cột Mã vận đơn có số thứ tự cột là 2, đồng thời chép cột Thời gian ký nhận (số cột 12) và chép thêm cột Tỉnh (số cột 19)

*Chân thành cảm ơn bạn rất nhiều!

Bạn gửi lại file kèm , mình coi lại xem thế nào ạ.
Mà bạn đang sử dụng chức năng trong sheet nào của file bài 25 nhỉ?

 

[acrox84]

Bạn gửi lại file kèm , mình coi lại xem thế nào ạ.
Mà bạn đang sử dụng chức năng trong sheet nào của file bài 25 nhỉ?

mình gửi đính kèm lại file Ghep NgayGiao và 2 file dữ liệu.

 

[Hoàng Nhật Phương]

mình gửi đính kèm lại file Ghep NgayGiao và 2 file dữ liệu.

Bạn tìm và thay thế bằng sub này nhé:

Private Sub CommandButton1_Click()
    
    Dim fso As Object, dic As Object
    Dim sheet As Worksheet, wbOpen As Workbook, cell As Range
    Dim arr As Variant, result() As String
    Dim sFolderName As String, fileName As String, sTinhThanh As String
    Dim MaVanDon As Variant, ThoiGianKyNhan As Variant
    Dim i As Long, r As Long
    Dim c As Integer
    Dim bFileOpened As Boolean
    
    getSpeed True
    
    On Error GoTo End_
    
    Set sheet = ThisWorkbook.ActiveSheet
    sFolderName = sheet.Range("C4")
    fileName = sheet.Range("C8")
    Set fso = CreateObject("Scripting.FileSystemObject")
    GoSub checkBook_
    
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 1)        'Ma Van don file nguon
        ThoiGianKyNhan = arr(i, 12) 'Thoi gian ky nhan
        sTinhThanh = arr(i, 19)     'Tinh Thanh
        dic.Item(MaVanDon) = Array(ThoiGianKyNhan, sTinhThanh)
    Next i
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    fileName = sheet.Range("C6")
    GoSub checkBook_
    r = UBound(arr, 1): c = UBound(arr, 2)
    ReDim result(1 To UBound(arr, 1), 1 To 2)
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 2) 'Ma Van Don file ket qua
        If dic.Exists(MaVanDon) Then
            result(i, 1) = dic.Item(MaVanDon)(0)
            result(i, 2) = dic.Item(MaVanDon)(1)
        End If
    Next i
    wbOpen.Worksheets(1).Range("A1").Offset(, c).Resize(r, 2) = result
    wbOpen.Save
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    MsgBox "BC MINH: Ghep KyNhan xong!", vbInformation + vbOKOnly
    GoTo End_
    
checkBook_:
    If fso.FileExists(sFolderName & "\" & fileName) Then
        On Error Resume Next
        Set wbOpen = Workbooks(fileName)
        On Error GoTo 0
        If wbOpen Is Nothing Then
            Set wbOpen = Workbooks.Open(sFolderName & "\" & fileName)
            bFileOpened = False
        End If
        arr = wbOpen.Worksheets(1).Range("A1").CurrentRegion.Value2
    Else
        MsgBox "Khong tim thay tap tin " & fileName & vbNewLine & _
            " trong thu muc " & sFolderName, vbCritical
        GoTo End_
    End If
    Return

End_:
    getSpeed False
    
End Sub

 

[acrox84]

Bạn tìm và thay thế bằng sub này nhé:

Private Sub CommandButton1_Click()
   
    Dim fso As Object, dic As Object
    Dim sheet As Worksheet, wbOpen As Workbook, cell As Range
    Dim arr As Variant, result() As String
    Dim sFolderName As String, fileName As String, sTinhThanh As String
    Dim MaVanDon As Variant, ThoiGianKyNhan As Variant
    Dim i As Long, r As Long
    Dim c As Integer
    Dim bFileOpened As Boolean
   
    getSpeed True
   
    On Error GoTo End_
   
    Set sheet = ThisWorkbook.ActiveSheet
    sFolderName = sheet.Range("C4")
    fileName = sheet.Range("C8")
    Set fso = CreateObject("Scripting.FileSystemObject")
    GoSub checkBook_
   
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 1)        'Ma Van don file nguon
        ThoiGianKyNhan = arr(i, 12) 'Thoi gian ky nhan
        sTinhThanh = arr(i, 19)     'Tinh Thanh
        dic.Item(MaVanDon) = Array(ThoiGianKyNhan, sTinhThanh)
    Next i
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    fileName = sheet.Range("C6")
    GoSub checkBook_
    r = UBound(arr, 1): c = UBound(arr, 2)
    ReDim result(1 To UBound(arr, 1), 1 To 2)
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 2) 'Ma Van Don file ket qua
        If dic.Exists(MaVanDon) Then
            result(i, 1) = dic.Item(MaVanDon)(0)
            result(i, 2) = dic.Item(MaVanDon)(1)
        End If
    Next i
    wbOpen.Worksheets(1).Range("A1").Offset(, c).Resize(r, 2) = result
    wbOpen.Save
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    MsgBox "BC MINH: Ghep KyNhan xong!", vbInformation + vbOKOnly
    GoTo End_
   
checkBook_:
    If fso.FileExists(sFolderName & "\" & fileName) Then
        On Error Resume Next
        Set wbOpen = Workbooks(fileName)
        On Error GoTo 0
        If wbOpen Is Nothing Then
            Set wbOpen = Workbooks.Open(sFolderName & "\" & fileName)
            bFileOpened = False
        End If
        arr = wbOpen.Worksheets(1).Range("A1").CurrentRegion.Value2
    Else
        MsgBox "Khong tim thay tap tin " & fileName & vbNewLine & _
            " trong thu muc " & sFolderName, vbCritical
        GoTo End_
    End If
    Return

End_:
    getSpeed False
   
End Sub

Ghép ngon lành 2 cột mới theo điều kiện trùng mã vận đơn rồi bạn, cảm ơn rất rất nhiều

 

[acrox84]

Bạn tìm và thay thế bằng sub này nhé:

Private Sub CommandButton1_Click()
   
    Dim fso As Object, dic As Object
    Dim sheet As Worksheet, wbOpen As Workbook, cell As Range
    Dim arr As Variant, result() As String
    Dim sFolderName As String, fileName As String, sTinhThanh As String
    Dim MaVanDon As Variant, ThoiGianKyNhan As Variant
    Dim i As Long, r As Long
    Dim c As Integer
    Dim bFileOpened As Boolean
   
    getSpeed True
   
    On Error GoTo End_
   
    Set sheet = ThisWorkbook.ActiveSheet
    sFolderName = sheet.Range("C4")
    fileName = sheet.Range("C8")
    Set fso = CreateObject("Scripting.FileSystemObject")
    GoSub checkBook_
   
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 1)        'Ma Van don file nguon
        ThoiGianKyNhan = arr(i, 12) 'Thoi gian ky nhan
        sTinhThanh = arr(i, 19)     'Tinh Thanh
        dic.Item(MaVanDon) = Array(ThoiGianKyNhan, sTinhThanh)
    Next i
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    fileName = sheet.Range("C6")
    GoSub checkBook_
    r = UBound(arr, 1): c = UBound(arr, 2)
    ReDim result(1 To UBound(arr, 1), 1 To 2)
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 2) 'Ma Van Don file ket qua
        If dic.Exists(MaVanDon) Then
            result(i, 1) = dic.Item(MaVanDon)(0)
            result(i, 2) = dic.Item(MaVanDon)(1)
        End If
    Next i
    wbOpen.Worksheets(1).Range("A1").Offset(, c).Resize(r, 2) = result
    wbOpen.Save
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    MsgBox "BC MINH: Ghep KyNhan xong!", vbInformation + vbOKOnly
    GoTo End_
   
checkBook_:
    If fso.FileExists(sFolderName & "\" & fileName) Then
        On Error Resume Next
        Set wbOpen = Workbooks(fileName)
        On Error GoTo 0
        If wbOpen Is Nothing Then
            Set wbOpen = Workbooks.Open(sFolderName & "\" & fileName)
            bFileOpened = False
        End If
        arr = wbOpen.Worksheets(1).Range("A1").CurrentRegion.Value2
    Else
        MsgBox "Khong tim thay tap tin " & fileName & vbNewLine & _
            " trong thu muc " & sFolderName, vbCritical
        GoTo End_
    End If
    Return

End_:
    getSpeed False
   
End Sub

Cho mình hỏi thêm, trường hợp MVĐ ở 2 cột thứ tự khác nhau giữa file nguồn và file đích thì điều chỉnh code này như thế nào ạ
Ví dụ: file Nguồn, MVĐ ở cột thứ 1 & file Đích, MVĐ ở cột thứ 2.

Mình thử vọc code trên của bạn, có thấy chép dữ liệu qua và hiện ra số 0 hoặc N/A hoặc số -60000 đều sai, như hình:

 

[Hoàng Nhật Phương]

Cho mình hỏi thêm, trường hợp MVĐ ở 2 cột thứ tự khác nhau giữa file nguồn và file đích thì điều chỉnh code này như thế nào ạ
Ví dụ: file Nguồn, MVĐ ở cột thứ 1 & file Đích, MVĐ ở cột thứ 2.

Mình thử vọc code trên của bạn, có thấy chép dữ liệu qua và hiện ra số 0 hoặc N/A hoặc số -60000 đều sai, như hình:
View attachment 291874

Code bài 32 mình đã có chú thích rồi mà bạn:

    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 1)        'Ma Van don file nguon
        ThoiGianKyNhan = arr(i, 12) 'Thoi gian ky nhan
        sTinhThanh = arr(i, 19)     'Tinh Thanh
        dic.Item(MaVanDon) = Array(ThoiGianKyNhan, sTinhThanh)
    Next i
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    fileName = sheet.Range("C6")
    GoSub checkBook_
    r = UBound(arr, 1): c = UBound(arr, 2)
    ReDim result(1 To UBound(arr, 1), 1 To 2)
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 2) 'Ma Van Don file ket qua
        If dic.Exists(MaVanDon) Then
            result(i, 1) = dic.Item(MaVanDon)(0)
            result(i, 2) = dic.Item(MaVanDon)(1)
        End If
    Next i

 

[acrox84]

Code bài 32 mình đã có chú thích rồi mà bạn:

    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 1)        'Ma Van don file nguon
        ThoiGianKyNhan = arr(i, 12) 'Thoi gian ky nhan
        sTinhThanh = arr(i, 19)     'Tinh Thanh
        dic.Item(MaVanDon) = Array(ThoiGianKyNhan, sTinhThanh)
    Next i
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    fileName = sheet.Range("C6")
    GoSub checkBook_
    r = UBound(arr, 1): c = UBound(arr, 2)
    ReDim result(1 To UBound(arr, 1), 1 To 2)
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 2) 'Ma Van Don file ket qua
        If dic.Exists(MaVanDon) Then
            result(i, 1) = dic.Item(MaVanDon)(0)
            result(i, 2) = dic.Item(MaVanDon)(1)
        End If
    Next i

Chết rồi, mình thử lại thì code bạn đúng nhưng vấn đề là do file mình muốn ghép lần này bị trùng MVĐ cho nên ra số sai -,-

Trường hợp bị trùng MVĐ, nếu yêu cầu mới như thế này bạn xem thực hiện được không nha (do kế toán không cấn trừ một lần mà thể hiện 1 MVĐ có tiền COD riêng và tiền cước phí riêng)

+Ví dụ, MVĐ: 842203689399 (chỗ tô đen đậm và tô đỏ - bị trùng MVĐ), mình muốn lấy cột số 6 (Tiền COD: 2165000) và cột số 13 (Tiền thực nhận: -128000) --> đưa 2 giá trị nào vào file đích cùng MVĐ.
Mình thấy nó có đặc điểm là lúc cột 13 có giá trị, thì cột 6 luôn = 0, mình có gửi đính kèm file này trong bài.

*Cột số 13 cũng không quan trọng lắm, nếu phức tạp quá thì bạn có thể cho mình xin code trùng MVĐ thì chỉ copy cột số 6 tiền COD >0 (hiện tại toàn copy số 0)

 

[Hoàng Nhật Phương]

Chết rồi, mình thử lại thì code bạn đúng nhưng vấn đề là do file mình muốn ghép lần này bị trùng MVĐ cho nên ra số sai -,-

Trường hợp bị trùng MVĐ, nếu yêu cầu mới như thế này bạn xem thực hiện được không nha (do kế toán không cấn trừ một lần mà thể hiện 1 MVĐ có tiền COD riêng và tiền cước phí riêng)

+Ví dụ, MVĐ: 842203689399 (chỗ tô đen đậm và tô đỏ - bị trùng MVĐ), mình muốn lấy cột số 6 (Tiền COD: 2165000) và cột số 13 (Tiền thực nhận: -128000) --> đưa 2 giá trị nào vào file đích cùng MVĐ.
Mình thấy nó có đặc điểm là lúc cột 13 có giá trị, thì cột 6 luôn = 0, mình có gửi đính kèm file này trong bài.

*Cột số 13 cũng không quan trọng lắm, nếu phức tạp quá thì bạn có thể cho mình xin code trùng MVĐ thì chỉ copy cột số 6 tiền COD >0 (hiện tại toàn copy số 0)
View attachment 291892

Copy từ đâu sang đâu bạn nhỉ, mình thấy form này khác các form trước phải không?

 

[acrox84]

Copy từ đâu sang đâu bạn nhỉ, mình thấy form này khác các form trước phải không?

từ file ketoan.xlsx sang file dulieu (form file dulieu cũ, mình có thay file ketoan sau khi phát hiện trả tiền COD có sai sót nên muốn ứng dụng tool ghép của bạn để đối chiếu 2 cột gần nhau)

 

[Hoàng Tuấn 868]

mình có thay file ketoan

Nếu thay file thì nên nhờ viết hoặc nhờ chỉnh code lại chứ ai lại bảo bị sai như bài #34 nhỉ. Nghe vậy người viết code chắc cũng có đôi chút chạnh lòng.

 

[acrox84]

Nếu thay file thì nên nhờ viết hoặc nhờ chỉnh code lại chứ ai lại bảo bị sai như bài #34 nhỉ. Nghe vậy người viết code chắc cũng có đôi chút chạnh lòng.

bạn nói đúng cái này là lỗi do mình, nhu cầu ban đầu của mình thì bạn Phương hoàn thiện rất tốt rồi, mình có báo ở bài #33

Còn #34 là mình hỏi để sử dụng lại tool này vào việc khác. Do mấy ngày trước, mình phát hiện file mình export thanh toán tiền khác với file kế toán.
Đó là trường hợp 1 khách lập đơn để tiền thu hộ COD 900k, hôm sau lại báo điều chỉnh lại về 0đ --> mình trả dư khách mất 900k.
Mình đang nghĩ cách đối chiếu số liệu giữa 2 file này thì nhớ code bạn Phương cho có khả năng tùy biến chép cột nên mình định chép 2 cột COD gần nhau để so sánh.

Do số lượng MVĐ ở 1 file rất nhiều và mình không nghĩ 1 MVĐ mà kế toán nó tách ra 2 lần, một lần trả tiền COD, một lần trả tiền cước, phiền phức như vậy. Nên sau khi phát hiện, mình cũng sợ hiểu lầm nên #36 khẳng định lại code bạn đúng.

 

[Hoàng Nhật Phương]

từ file ketoan.xlsx sang file dulieu (form file dulieu cũ, mình có thay file ketoan sau khi phát hiện trả tiền COD có sai sót nên muốn ứng dụng tool ghép của bạn để đối chiếu 2 cột gần nhau)

Bạn đính kèm lại một vài dữ liệu mẫu sau khi chuyển từ file ketoan.xlsx sang dulieu để mình coi xem thế nào

 

[Hoàng Tuấn 868]

Còn #34 là mình hỏi

Cách hỏi trong môi trường này khá quan trọng, có những bài khá đơn giản nhưng chỉ vì cách hỏi mà không thành viên nào trả lời đó bạn.

 

[acrox84]

Bạn đính kèm lại một vài dữ liệu mẫu sau khi chuyển từ file ketoan.xlsx sang dulieu để mình coi xem thế nào

Mình đính kèm lại 2 file, dulieu0 là mình xuất từ hệ thống đại lý bên mình, ketoan0 là kế toán cty trả qua mail để đối soát tiền. Đợt này, dính MVĐ: 842203481918, bị lệch COD giữa 2 file trên.

*Vấn đề của mình ntn, mình đang mua NQ chuyển phát nhanh, cty cấp cho mình 1 tk đại lý.
Khi lập xong MVĐ, các thông số MVĐ đều có trên tk đại lý, nhưng khi MVĐ có thay đổi về trọng lượng, tiền COD,... thì tk đại lý của mình không cập nhật theo.
Chỉ có file kế toán bên cty gửi mới có, mà file kế toán thì gửi chậm và không đầy đủ thông tin, mình đang không biết làm sao đối chiếu phát hiện sai sót nên muốn ghép lại để chúng cạnh nhau.

 

[Hoàng Nhật Phương]

Chết rồi, mình thử lại thì code bạn đúng nhưng vấn đề là do file mình muốn ghép lần này bị trùng MVĐ cho nên ra số sai -,-

Trường hợp bị trùng MVĐ, nếu yêu cầu mới như thế này bạn xem thực hiện được không nha (do kế toán không cấn trừ một lần mà thể hiện 1 MVĐ có tiền COD riêng và tiền cước phí riêng)

+Ví dụ, MVĐ: 842203689399 (chỗ tô đen đậm và tô đỏ - bị trùng MVĐ), mình muốn lấy cột số 6 (Tiền COD: 2165000) và cột số 13 (Tiền thực nhận: -128000) --> đưa 2 giá trị nào vào file đích cùng MVĐ.
Mình thấy nó có đặc điểm là lúc cột 13 có giá trị, thì cột 6 luôn = 0, mình có gửi đính kèm file này trong bài.

*Cột số 13 cũng không quan trọng lắm, nếu phức tạp quá thì bạn có thể cho mình xin code trùng MVĐ thì chỉ copy cột số 6 tiền COD >0 (hiện tại toàn copy số 0)
View attachment 291892

Mình đính kèm lại 2 file, dulieu0 là mình xuất từ hệ thống đại lý bên mình, ketoan0 là kế toán cty trả qua mail để đối soát tiền. Đợt này, dính MVĐ: 842203481918, bị lệch COD giữa 2 file trên.

*Vấn đề của mình ntn, mình đang mua NQ chuyển phát nhanh, cty cấp cho mình 1 tk đại lý.
Khi lập xong MVĐ, các thông số MVĐ đều có trên tk đại lý, nhưng khi MVĐ có thay đổi về trọng lượng, tiền COD,... thì tk đại lý của mình không cập nhật theo.
Chỉ có file kế toán bên cty gửi mới có, mà file kế toán thì gửi chậm và không đầy đủ thông tin, mình đang không biết làm sao đối chiếu phát hiện sai sót nên muốn ghép lại để chúng cạnh nhau.

Mình xem nhưng chưa hiểu, với dữ liệu từ fille kế toán như thế này thì bạn mong muốn đưa sang file dữ liệu như thế nào?

 

[acrox84]

Mình xem nhưng chưa hiểu, với dữ liệu từ fille kế toán như thế này thì bạn mong muốn đưa sang file dữ liệu như thế nào?
View attachment 291957

chỗ MVĐ tô vàng đó đã bị lệch COD nên bỏ qua, ý mình muốn chép qua như thế này:
*Cột P mới lấy tiền COD bên file kế toán qua, trong file kế toán có 2 dạng MVĐ:
+MVĐ không trùng, lấy số tiền COD bóc qua.
+MVĐ trùng (xuất hiện 2 lần, là những ô mình tô màu cam), cần lấy số tiền COD >0, bỏ ô giá trị COD = 0.

Mình đính kèm tệp kết quả mình mong muốn:


*Với mục đích của mình là so sánh giá trị COD trước (file dulieu) và COD sau (file ketoan) nên nếu cột P bạn clone thêm 1 lần cột L (tiền thu hộ) để cột mới Q bên cạnh cho mình dễ so sánh thì quá tốt rồi ^__^

 

[Hoàng Nhật Phương]

Phần 1: chỗ MVĐ tô vàng đó đã bị lệch COD nên bỏ qua, ý mình muốn chép qua như thế này:
..
Phần 2: *Với mục đích của mình là so sánh giá trị COD trước (file dulieu) và COD sau (file ketoan) nên nếu cột P bạn clone thêm 1 lần cột L (tiền thu hộ) để cột mới Q bên cạnh cho mình dễ so sánh thì quá tốt rồi ^__^

Mình chưa hiểu lắm nên làm tù mù (tù mù phần 1) .. còn phần 2 mình chưa hiểu gì luôn :

Private Sub CommandButton1_Click()
    
    Dim fso As Object, dic As Object
    Dim sheet As Worksheet, wbOpen As Workbook, cell As Range
    Dim arr As Variant, result() As String
    Dim sFolderName As String, fileName As String, s1 As String, s2 As String
    Dim MaVanDon As Variant, tienCOD As Variant, tienThucNhan As Variant
    Dim i As Long, r As Long
    Dim c As Integer
    Dim bFileOpened As Boolean
    
    getSpeed True
    
    On Error GoTo End_
    
    Set sheet = ThisWorkbook.ActiveSheet
    sFolderName = sheet.Range("C4")
    fileName = sheet.Range("C8")
    Set fso = CreateObject("Scripting.FileSystemObject")
    GoSub checkBook_
  
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 1)        'Ma Van don file nguon
        tienCOD = arr(i, 6)         'Tien COD
        tienThucNhan = arr(i, 13)   'Tien Thuc Nhan
        If Not dic.Exists(MaVanDon) Then
            If s1 = "" Then s1 = arr(1, 6)  'Tieu de Tien COD
            If s2 = "" Then s2 = arr(1, 13) 'Tieu de Tien Thuc Nhan
            dic.Add MaVanDon, Array(tienCOD, tienThucNhan)
        ElseIf CDbl(tienCOD) > 0 Then
            dic.Item(MaVanDon) = Array(tienCOD, tienThucNhan)
        End If
    Next i
    
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    fileName = sheet.Range("C6")
    GoSub checkBook_
    r = UBound(arr, 1): c = UBound(arr, 2)
    ReDim result(1 To UBound(arr, 1), 1 To 2)
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 2) 'Ma Van Don file ket qua
        If dic.Exists(MaVanDon) Then
            If (result(1, 1) = "") Then result(1, 1) = s1
            If (result(1, 2) = "") Then result(1, 2) = s2
            result(i, 1) = dic.Item(MaVanDon)(0)
            result(i, 2) = dic.Item(MaVanDon)(1)
        End If
    Next i
    
    wbOpen.Worksheets(1).Range("A1").Offset(, 15).Resize(r, 2) = result
    wbOpen.Save
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    MsgBox "BC MINH: Ghep KyNhan xong!", vbInformation + vbOKOnly
    GoTo End_
    
checkBook_:
    If fso.FileExists(sFolderName & "\" & fileName) Then
        On Error Resume Next
        Set wbOpen = Workbooks(fileName)
        On Error GoTo 0
        If wbOpen Is Nothing Then
            Set wbOpen = Workbooks.Open(sFolderName & "\" & fileName)
            bFileOpened = False
        End If
        arr = wbOpen.Worksheets(1).Range("A1").CurrentRegion.Value2
    Else
        MsgBox "Khong tim thay tap tin " & fileName & vbNewLine & _
            " trong thu muc " & sFolderName, vbCritical
        GoTo End_
    End If
    Return

End_:
    getSpeed False
    
End Sub

 

[Jayce]

@Hoàng Nhật Phương
Bác có thể giành chút thời gian xem giúp em với được không ạ?
Bài viết

 

[acrox84]

Mình chưa hiểu lắm nên làm tù mù (tù mù phần 1) .. còn phần 2 mình chưa hiểu gì luôn :

Private Sub CommandButton1_Click()
  
    Dim fso As Object, dic As Object
    Dim sheet As Worksheet, wbOpen As Workbook, cell As Range
    Dim arr As Variant, result() As String
    Dim sFolderName As String, fileName As String, s1 As String, s2 As String
    Dim MaVanDon As Variant, tienCOD As Variant, tienThucNhan As Variant
    Dim i As Long, r As Long
    Dim c As Integer
    Dim bFileOpened As Boolean
  
    getSpeed True
  
    On Error GoTo End_
  
    Set sheet = ThisWorkbook.ActiveSheet
    sFolderName = sheet.Range("C4")
    fileName = sheet.Range("C8")
    Set fso = CreateObject("Scripting.FileSystemObject")
    GoSub checkBook_
 
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 1)        'Ma Van don file nguon
        tienCOD = arr(i, 6)         'Tien COD
        tienThucNhan = arr(i, 13)   'Tien Thuc Nhan
        If Not dic.Exists(MaVanDon) Then
            If s1 = "" Then s1 = arr(1, 6)  'Tieu de Tien COD
            If s2 = "" Then s2 = arr(1, 13) 'Tieu de Tien Thuc Nhan
            dic.Add MaVanDon, Array(tienCOD, tienThucNhan)
        ElseIf CDbl(tienCOD) > 0 Then
            dic.Item(MaVanDon) = Array(tienCOD, tienThucNhan)
        End If
    Next i
  
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    fileName = sheet.Range("C6")
    GoSub checkBook_
    r = UBound(arr, 1): c = UBound(arr, 2)
    ReDim result(1 To UBound(arr, 1), 1 To 2)
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        MaVanDon = arr(i, 2) 'Ma Van Don file ket qua
        If dic.Exists(MaVanDon) Then
            If (result(1, 1) = "") Then result(1, 1) = s1
            If (result(1, 2) = "") Then result(1, 2) = s2
            result(i, 1) = dic.Item(MaVanDon)(0)
            result(i, 2) = dic.Item(MaVanDon)(1)
        End If
    Next i
  
    wbOpen.Worksheets(1).Range("A1").Offset(, 15).Resize(r, 2) = result
    wbOpen.Save
    If Not bFileOpened Then wbOpen.Close False: Set wbOpen = Nothing
    MsgBox "BC MINH: Ghep KyNhan xong!", vbInformation + vbOKOnly
    GoTo End_
  
checkBook_:
    If fso.FileExists(sFolderName & "\" & fileName) Then
        On Error Resume Next
        Set wbOpen = Workbooks(fileName)
        On Error GoTo 0
        If wbOpen Is Nothing Then
            Set wbOpen = Workbooks.Open(sFolderName & "\" & fileName)
            bFileOpened = False
        End If
        arr = wbOpen.Worksheets(1).Range("A1").CurrentRegion.Value2
    Else
        MsgBox "Khong tim thay tap tin " & fileName & vbNewLine & _
            " trong thu muc " & sFolderName, vbCritical
        GoTo End_
    End If
    Return

End_:
    getSpeed False
  
End Sub

Cái phần 2 không cần thiết lắm, mình chỉ muốn để 2 cột cũ và mới sát nhau cho dễ quan sát thôi.

Mình áp code vào dữ liệu đợt thanh toán hôm nay thì hiện #NA và dòng tiêu đề nhảy xuống dưới khá nhiều,
mình có đính kèm lại 3 file cho bạn dễ kiểm tra nha.

 

[acrox84]

[/QUOTE]
mình gà mờ quá nên paste code qua sheet khác bị lỗi rồi ạ, nhờ bạn check lại giúp. 
Còn để chạy trên dữ liệu cũ file dulieu0 và ketoan0 nó lại chuẩn :((

 

[Hoàng Nhật Phương]

Cái phần 2 không cần thiết lắm, mình chỉ muốn để 2 cột cũ và mới sát nhau cho dễ quan sát thôi.

Mình áp code vào dữ liệu đợt thanh toán hôm nay thì hiện #NA và dòng tiêu đề nhảy xuống dưới khá nhiều,
mình có đính kèm lại 3 file cho bạn dễ kiểm tra nha.

View attachment 292024

Mình nhìn ảnh thấy dữ liệu đang ở chế độ fillter bạn thửu bỏ lọc rồi thử lại xem.

 

[acrox84]

Mình nhìn ảnh thấy dữ liệu đang ở chế độ fillter bạn thửu bỏ lọc rồi thử lại xem.

vãi, pro thật! đúng bệnh rồi, bỏ filter cái chạy phát hết N/A luôn. Do mình cần lọc filter theo ngày trước rồi mới ghép, giờ mình đảo bước lại. Cảm ơn bạn Phương nhiều lắm!

 

[Hoàng Tuấn 868]

Mình nhìn ảnh thấy dữ liệu đang ở chế độ fillter bạn thửu bỏ lọc rồi thử lại xem.

Thêm một dòng lệnh kiểm tra, nếu đang ở chế độ filter thì bỏ filter là ổn nhỉ.

 

[acrox84]

Thêm một dòng lệnh kiểm tra, nếu đang ở chế độ filter thì bỏ filter là ổn nhỉ.

trường hợp này của mình tự bỏ filter rồi làm tiếp thì không được.
Do đang dùng chức năng lọc nâng cao theo Ngày giao thành công trong khoảng thời gian chỉ định của app KuTools. Lọc xong rồi nhờ code của bạn Cu Tồ phân loại Người gửi theo SĐT để trả tiền COD.
Hiện tại đang kết hợp thêm code bạn Hoàng Nhật Phương để gộp 2 file excel cùng cấu trúc và ghép dữ liệu theo điều kiện MVĐ các thứ.
Nên tiếp theo mình sẽ dùng app KuTool xóa các dòng hidden do bộ lọc filter rồi chạy code ghép của bạn Phương.

*Mình làm đại lý điểm gom hàng mà bên cty không cung cấp app cho dùng, nên mỗi khi khó khăn đều phải lên diễn đàn GPEX của mình nhờ anh em trợ giúp, trộm vía được anh em hỗ trợ nhiệt tình mà không đòi hỏi gì khác, mình rất là trân trọng và chân thành cảm ơn^_^

 

[Hoàng Tuấn 868]

trường hợp này của mình tự bỏ filter rồi làm tiếp thì không được.

Sau khi chạy xong thì thêm lệnh trả lại chế độ filter như cũ thôi.

 

[acrox84]

Sau khi chạy xong thì thêm lệnh trả lại chế độ filter như cũ thôi.

Không biết nữa, mình chưa thử, nhưng kiểu lọc Super bên KuTool như lập trình vậy đó, kiểu bấm Bật / Tắt Filter nó không ra lại như cũ.

Như hình là mình đang dùng chức năng lọc cột P (Ngày Giao Thành Công) từ 21-06 đến 22-06, lọc xong dùng code bạn Cu Tồ chạy tiếp được, còn code bạn khác thì không chạy được sau khi filter, cũng không hiểu sao hehe..

 

[Hoàng Tuấn 868]

Không biết nữa, mình chưa thử,

Có mất nhiều thời gian đâu mà không thử nhỉ.

 

[acrox84]

Có mất nhiều thời gian đâu mà không thử nhỉ.

mình có biết gõ code đâu mà thử kkk

 

[Hoàng Tuấn 868]

mình có biết gõ code đâu mà thử

Vậy thì chịu khó học dần dần, tìm hiểu xem cú pháp hai dòng lệnh đó như thế nào, rồi hỏi cách chèn vào đâu cho phù hợp và thử, nếu chưa được hoặc lỗi lại hỏi tiếp cho đến khi thành công, cái đó chắc rất nhiều thành viên sẵn lòng giúp bạn, chứ không lẽ bạn định đi nhờ mãi sao.

 

[acrox84]

Bạn gửi lại file kèm , mình coi lại xem thế nào ạ.
Mà bạn đang sử dụng chức năng trong sheet nào của file bài 25 nhỉ?

Năm ngoái bạn @Hoàng Nhật Phương có giúp mình làm Tools ghép 2 file dữ liệu làm một, do file dữ liệu hiện giờ của mình thay đổi cách trình bày (bảng dữ liệu cột bắt đầu từ dòng thứ 9) mà mình thử chỉnh sửa code cũ không làm được nên nhờ bạn hoặc những bro GPE giúp mình sửa lại code để mình được tiếp tục dùng Tools

*Yêu cầu là Tạo ra file dulieu.xlsx là toàn bộ bảng thông tin của dulieu2.xlsx (bắt đầu từ dòng thứ 10) gộp với dulieu1.xlsx, 2 file này có cấu trúc & tiêu đề cột đều giống nhau.

mình đính kèm lại code cũ, bắt đầu chép từ dòng 1 của file & đính kèm 3 file excel trong bài, nhờ các bạn trợ giúp, Chân thành cảm ơn!!

Option Explicit

Private Sub CommandButton1_Click()

Dim wb As Workbook, wbNew As Workbook, ws As Worksheet, wsNew As Worksheet, col As Range, colNew As Range
Dim lastRow As Long, lastCol As Long, lastRowNew As Long
Dim colTitle As String, sFolder As String, newFileName As String, filePath As String
Dim fso As Object, fileNames As Variant, fileName As Variant

getSpeed True
On Error GoTo End_
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = Me.Range("C4").Value

If Not fso.FolderExists(sFolder) Then
MsgBox "Khong tim thay thu muc: " & vbNewLine & sFolder, vbCritical
GoTo End_
End If
fileNames = Split(Me.Range("C6").Value, ";")
Set wbNew = Workbooks.Add: Set wsNew = wbNew.Worksheets(1)
lastRowNew = 1
For Each fileName In fileNames
filePath = sFolder & "\" & fileName
If Not fso.FileExists(filePath) Then
MsgBox "Khong tim thay tap tin: " & vbNewLine & filePath, vbCritical
GoTo End_
End If
Set wb = Workbooks.Open(filePath): Set ws = wb.Worksheets(1)
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
If lastRowNew = 1 Then
ws.UsedRange.Copy Destination:=wsNew.Cells(lastRowNew, 1)
lastRowNew = lastRow
Else
For Each col In ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol))
colTitle = col.Cells(1).Value
Set colNew = wsNew.Rows(1).Find(colTitle, LookIn:=xlValues, LookAt:=xlWhole)
If Not colNew Is Nothing Then
ws.Range(col.Cells(2), col.Cells(lastRow)).Copy Destination:=wsNew.Cells(wsNew.Cells(wsNew.Rows.Count, colNew.Column).End(xlUp).Row + 1, colNew.Column)
End If
Next col
lastRowNew = lastRowNew + lastRow - 1
End If
wb.Close SaveChanges:=False
Next fileName

newFileName = "dulieu" & ".xlsx"
wbNew.SaveAs sFolder & "\" & newFileName
wbNew.Close SaveChanges:=False
MsgBox "Done! Da gop dulieu"

End_:
getSpeed False

End Sub

 

[Hoàng Nhật Phương]

Năm ngoái bạn @Hoàng Nhật Phương có giúp mình làm Tools ghép 2 file dữ liệu làm một, do file dữ liệu hiện giờ của mình thay đổi cách trình bày (bảng dữ liệu cột bắt đầu từ dòng thứ 9) mà mình thử chỉnh sửa code cũ không làm được nên nhờ bạn hoặc những bro GPE giúp mình sửa lại code để mình được tiếp tục dùng Tools

*Yêu cầu là Tạo ra file dulieu.xlsx là toàn bộ bảng thông tin của dulieu2.xlsx (bắt đầu từ dòng thứ 10) gộp với dulieu1.xlsx, 2 file này có cấu trúc & tiêu đề cột đều giống nhau.

mình đính kèm lại code cũ, bắt đầu chép từ dòng 1 của file & đính kèm 3 file excel trong bài, nhờ các bạn trợ giúp, Chân thành cảm ơn!!

Mình cũng chưa hiểu rõ vấn đề bạn cần, tuy nhiên bạn thử sửa lại đoạn sau:

'-----Code khác giữ nguyên--------------
For Each fileName In fileNames
        filePath = sFolder & "\" & fileName
        If Not fso.FileExists(filePath) Then
            MsgBox "Khong tim thay tap tin: " & vbNewLine & filePath, vbCritical
            GoTo End_
        End If
        Set wb = Workbooks.Open(filePath):  Set ws = wb.Worksheets(1)
        lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
        lastCol = ws.Cells(9, ws.Columns.Count).End(xlToLeft).Column
        If lastRowNew = 1 Then
            ws.UsedRange.Copy Destination:=wsNew.Cells(lastRowNew, 1)
            lastRowNew = lastRow
        Else
            For Each col In ws.Range(ws.Cells(9, 1), ws.Cells(9, lastCol))
                colTitle = col.Cells(1).Value
                Set colNew = wsNew.Rows(9).Find(colTitle, LookIn:=xlValues, LookAt:=xlWhole)
                If Not colNew Is Nothing Then
                    ws.Range(col.Cells(10), col.Cells(lastRow)).Copy Destination:=wsNew.Cells(wsNew.Cells(wsNew.Rows.Count, colNew.Column).End(xlUp).Row + 1, colNew.Column)
                End If
            Next col
            lastRowNew = lastRowNew + lastRow - 1
        End If
        wb.Close SaveChanges:=False
    Next fileName
'-----Code khác giữ nguyên--------------

Nếu có vấn đề gì thì bạn mô tả rõ hơn để mọi người cùng xem và giúp bạn,
Cảm ơn.

 

[acrox84]

Mình cũng chưa hiểu rõ vấn đề bạn cần, tuy nhiên bạn thử sửa lại đoạn sau:

'-----Code khác giữ nguyên--------------
For Each fileName In fileNames
        filePath = sFolder & "\" & fileName
        If Not fso.FileExists(filePath) Then
            MsgBox "Khong tim thay tap tin: " & vbNewLine & filePath, vbCritical
            GoTo End_
        End If
        Set wb = Workbooks.Open(filePath):  Set ws = wb.Worksheets(1)
        lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
        lastCol = ws.Cells(9, ws.Columns.Count).End(xlToLeft).Column
        If lastRowNew = 1 Then
            ws.UsedRange.Copy Destination:=wsNew.Cells(lastRowNew, 1)
            lastRowNew = lastRow
        Else
            For Each col In ws.Range(ws.Cells(9, 1), ws.Cells(9, lastCol))
                colTitle = col.Cells(1).Value
                Set colNew = wsNew.Rows(9).Find(colTitle, LookIn:=xlValues, LookAt:=xlWhole)
                If Not colNew Is Nothing Then
                    ws.Range(col.Cells(10), col.Cells(lastRow)).Copy Destination:=wsNew.Cells(wsNew.Cells(wsNew.Rows.Count, colNew.Column).End(xlUp).Row + 1, colNew.Column)
                End If
            Next col
            lastRowNew = lastRowNew + lastRow - 1
        End If
        wb.Close SaveChanges:=False
    Next fileName
'-----Code khác giữ nguyên--------------

Nếu có vấn đề gì thì bạn mô tả rõ hơn để mọi người cùng xem và giúp bạn,
Cảm ơn.

Cảm ơn bạn HNP, hồi tháng 11 mình vướng vấn đề này nên có lên forum nhờ mọi người đã xử lý rồi, chút mình copy code của bạn add vào thử lại xem sau, do bạn kia cung cấp cách giải quyết vấn đề khác.
Thời gian đó mình ko thấy bạn online diễn đàn nên cũng hơi lo, năm mới chúc bạn và gia đình nhiều sức khỏe, thật nhiều may mắn. Cảm ơn bạn rất nhiều