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

[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]

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