GỘP FILE VÀ TỔNG HỢP DỮ LIỆU! (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
huonglien1901

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia
17/4/16
Bài viết
2,701
Được thích
2,434
Giới tính
Nam
Nghề nghiệp
Nhân viên kỹ thuật in ấn
Chào mọi người!

Em có vấn đề nhờ mọi người giúp.

Em có 3 sheet: t1, t5, t23.

Em muốn copy file t5 vào file t1, copy file t23 vào t1(dữ liệu cứ nối tiếp nhau, t1, t5, t23 không lấy tiêu đề cột chỉ lấy dữ liệu file t5,t23. Xóa bỏ Cột A trong file t1.
sau đó dùng hàm mid để lấy ra kí tự 79,88(mid(cột Cext,15,2) rồi xóa 79,88 đi.
Em muốn định dạng cột SKU QUANLITY, Cột Weight/SKU, Cột Purchase Stock Value, Cột Stock Cost Value, Sale Stock Value là kiểu Number.
Cột DATE OF DATA, Cột SEQ thì xóa bỏ.
Cột Suppler Code dò kết quả bên Sheet Oder dass, dựa vào Cột Barcode. Nếu trường hợp không tìm thấy thì bỏ trống.
Cột Suppler Desc dò kết quả bên sheet Oderdass dựa vào cột Barcode. Nếu vẫn không tìm thấy thì dò kết quả dựa vào cột CODE, Nếu không tìm thấy hoặc lỗi #NA thì gán giá trị rỗng.
Em cảm ơn mọi người nhiều!
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
huonglien1901 đã viết:
Cột Suppler Code dò kết quả bên Sheet Oder dass, dựa vào Cột Barcode. Nếu trường hợp không tìm thấy thì bỏ trống.
Cột Suppler Desc dò kết quả bên sheet Oderdass dựa vào cột Barcode. Nếu vẫn không tìm thấy thì dò kết quả dựa vào cột CODE, Nếu không tìm thấy hoặc lỗi #NA thì gán giá trị rỗng.
Nhấp chuột vào đây để mở rộng...
Bạn giải thích và cho kết quả mẫu của cột J, K xem sao. Dữ liệu chẳng tìm thấy ở dòng nào cả.
 

File đính kèm

Upvote 0
Ba Tê đã viết:
Bạn giải thích và cho kết quả mẫu của cột J, K xem sao. Dữ liệu chẳng tìm thấy ở dòng nào cả.
Nhấp chuột vào đây để mở rộng...
Chắc Bác giờ này ngủ rồi phải không?
Em test code Anh có những vấn đề như sau.
Code Ạnh không lấy sheet t1.
Nhờ Anh vẫn giữ định dạng lỗi #NA.
Em gửi file làm bằng tay bằng công thức!
Em cảm Anh nhiều!
 

File đính kèm

Upvote 0
Hai Lúa Miền Tây đã viết:
Bạn test thử code sau nhé:

PHP: 
Sub LayDL()
    Dim v, strPath, strSQL As String
    v = Application.Version
    strPath = ThisWorkbook.FullName
    strSQL = "SELECT [t1$].SITE, [t1$].CEXT, [t1$].CODE, [t1$].BARCODE, [t1$].SU, [t1$].LV, [t1$].[Article Status], [t1$].DESCRIPTION, [oder dass$].SUPCOD, [oder dass$].SUPPLIER, Val([t1$].[SKU quantity]) AS [SKU quantity], Val([t1$].[Weight/SKU]) AS [Weight/SKU], [t1$].[Unit purchase price], [t1$].[Unit Cost Price], [t1$].[Unit Sales Price], Val([t1$].[Purchase Stock Value]) AS [Purchase Stock Value], Val([t1$].[Stock Cost Value]) AS [Stock Cost Value], Val([t1$].[Sales Stock Value]) AS [Sales Stock Value] FROM [t1$] LEFT JOIN [oder dass$] ON [t1$].BARCODE = [oder dass$].BARCODE where mid([CEXT],15,2) not in (79,88) " & vbCrLf
    strSQL = strSQL & "union all SELECT [t5$].SITE, [t5$].CEXT, [t5$].CODE, [t5$].BARCODE, [t5$].SU, [t5$].LV, [t5$].[Article Status], [t5$].DESCRIPTION, [oder dass$].SUPCOD, [oder dass$].SUPPLIER, Val([t5$].[SKU quantity]) AS [SKU quantity], Val([t5$].[Weight/SKU]) AS [Weight/SKU], [t5$].[Unit purchase price], [t5$].[Unit Cost Price], [t5$].[Unit Sales Price], Val([t5$].[Purchase Stock Value]) AS [Purchase Stock Value], Val([t5$].[Stock Cost Value]) AS [Stock Cost Value], Val([t5$].[Sales Stock Value]) AS [Sales Stock Value] FROM [t5$] LEFT JOIN [oder dass$] ON [t5$].BARCODE = [oder dass$].BARCODE where mid([CEXT],15,2) not in (79,88) " & vbCrLf
    strSQL = strSQL & "union all SELECT [t23$].SITE, [t23$].CEXT, [t23$].CODE, [t23$].BARCODE, [t23$].SU, [t23$].LV, [t23$].[Article Status], [t23$].DESCRIPTION, [oder dass$].SUPCOD, [oder dass$].SUPPLIER, Val([t23$].[SKU quantity]) AS [SKU quantity], Val([t23$].[Weight/SKU]) AS [Weight/SKU], [t23$].[Unit purchase price], [t23$].[Unit Cost Price], [t23$].[Unit Sales Price], Val([t23$].[Purchase Stock Value]) AS [Purchase Stock Value], Val([t23$].[Stock Cost Value]) AS [Stock Cost Value], Val([t23$].[Sales Stock Value]) AS [Sales Stock Value] FROM [t23$] LEFT JOIN [oder dass$] ON [t23$].BARCODE = [oder dass$].BARCODE where mid([CEXT],15,2) not in (79,88) " & vbCrLf
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & strPath & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
        Sheet5.Range("A2:V65000").ClearContents
        Sheet5.Range("A2").CopyFromRecordset .Execute(strSQL)
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn Anh nhiều!

Nhờ Anh giúp em vẫn giữ định dạng lỗi#NA được không Anh khi không tìm thấy dữ liệu, Thì code sẽ thay đổi như thế nào Anh ơi.
 
Upvote 0
HieuCD đã viết:
đã bỏ 79 và 88
cột J, và cột K không có vì tìm không thấy, nếu có thì bạn cho ví dụ dòng nào
Mã: 
Sub GhepT3T5()
Dim Darr(), Sarr(), Arr(), LastR As Long, iR As Long
iR = Sheets("t1").Range("B" & Rows.Count).End(xlUp).Row
With Sheets("t5")
  LastR = .Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("A2:T" & LastR).Value
    Sheets("t1").Range("D" & iR + 1).Resize(UBound(Darr), 2).NumberFormat = "@"
    Sheets("t1").Range("B" & iR + 1).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
  End If
End With
With Sheets("t23")
  LastR = .Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("A2:T" & LastR).Value
    LastR = Sheets("t1").Range("B" & Rows.Count).End(xlUp).Row
    Sheets("t1").Range("D" & LastR + 1).Resize(UBound(Darr), 2).NumberFormat = "@"
    Sheets("t1").Range("B" & LastR + 1).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
  End If
End With
With Sheets("oder dass")
  LastR = .Range("E" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("E2:J" & LastR).Value
  End If
End With
With Sheets("t1")
  LastR = .Range("B" & Rows.Count).End(xlUp).Row
  Arr = .Range(.Cells(iR + 1, "D"), .Cells(LastR, "E")).Value
  Sarr = .Range(.Cells(iR + 1, "C"), .Cells(LastR, "C")).Value
End With
With CreateObject("scripting.dictionary")
  For i = 1 To UBound(Arr)
    If Mid(Sarr(i, 1), 15, 2) = "79" Or Mid(Sarr(i, 1), 15, 2) = "88" Then
      Sarr(i, 1) = Mid(Sarr(i, 1), 1, 14) & Mid(Sarr(i, 1), 17, 100)
    End If
    If Arr(i, 1) <> "" Then
      tmp = "C" & CStr(Arr(i, 1))
      If Not .exists(tmp) Then .Add (tmp), i
    End If
    If Arr(i, 2) <> "" Then
      tmp = "B" & CStr(Arr(i, 2))
      If Not .exists(tmp) Then .Add (tmp), i
    End If
  Next i
  ReDim Arr(1 To UBound(Arr), 1 To 2)
  For i = 1 To UBound(Darr)
    If Darr(i, 1) <> "" Then
      k = 0
      tmp = "B" & CStr(Darr(i, 1))
      If .exists(tmp) Then
        k = .Item(tmp)
        Arr(k, 1) = Darr(i, 5)
        If CStr(Darr(i, 6)) <> "Error 2042" Then Arr(k, 2) = Darr(i, 6)
      Else
        tmp = "C" & CStr(Darr(i, 1))
        If .exists(tmp) Then
          k = .Item(tmp)
          If CStr(Darr(i, 6)) <> "Error 2042" Then Arr(k, 2) = Darr(i, 6)
        End If
      End If
    End If
  Next i
End With
With Sheets("t1")
  LastR = .Range("B" & Rows.Count).End(xlUp).Row
  .Range("J" & iR + 1).Resize(UBound(Arr), 2) = Arr
  .Range("C" & iR + 1).Resize(UBound(Arr)) = Sarr
  .Range(.Cells(iR + 1, "T"), .Cells(LastR, "U")).ClearContents
  .Range(.Cells(iR + 1, "L"), .Cells(LastR, "M")).NumberFormat = "#,###"
  .Range(.Cells(iR + 1, "Q"), .Cells(LastR, "S")).NumberFormat = "#,###"
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Em test code Anh,
1. Chưa xóa được cột T, U đó Anh.
Nhờ anh vẫn giữ định dạng lỗi #NA như trong file đính kèm đó Anh. không gán cho giá tri rỗng nữa.

Em cảm ơn Anh nhiều!
Chúc Anh ngủ ngon sau ngày làm việc mệt nhọc.
 
Upvote 0
huonglien1901 đã viết:
Em test code Anh,
1. Chưa xóa được cột T, U đó Anh.
Nhờ anh vẫn giữ định dạng lỗi #NA như trong file đính kèm đó Anh. không gán cho giá tri rỗng nữa.

Em cảm ơn Anh nhiều!
Chúc Anh ngủ ngon sau ngày làm việc mệt nhọc.
Nhấp chuột vào đây để mở rộng...
lúc đầu bỏ sao bậy giờ lại tiếc giữ lại?
cột T và U mình đã xóa bằng lệnh
Mã: 
.Range(.Cells(iR + 1, "T"), .Cells(LastR, "U")).ClearContents
trong code điều kiện lấy dữ liêu mình còn lấn cấn chưa chắc đúng ý bạn
Mã: 
Sub GhepT3T5()
Dim Darr(), Sarr(), Arr(), LastR As Long, iR As Long
iR = Sheets("t1").Range("B" & Rows.Count).End(xlUp).Row
With Sheets("t5")
  LastR = .Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("A2:T" & LastR).Value
    Sheets("t1").Range("D" & iR + 1).Resize(UBound(Darr), 2).NumberFormat = "@"
    Sheets("t1").Range("B" & iR + 1).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
  End If
End With
With Sheets("t23")
  LastR = .Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("A2:T" & LastR).Value
    LastR = Sheets("t1").Range("B" & Rows.Count).End(xlUp).Row
    Sheets("t1").Range("D" & LastR + 1).Resize(UBound(Darr), 2).NumberFormat = "@"
    Sheets("t1").Range("B" & LastR + 1).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
  End If
End With
With Sheets("oder dass")
  LastR = .Range("E" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("E2:J" & LastR).Value
  End If
End With
With Sheets("t1")
  LastR = .Range("B" & Rows.Count).End(xlUp).Row
  Arr = .Range(.Cells(iR + 1, "D"), .Cells(LastR, "E")).Value
  Sarr = .Range(.Cells(iR + 1, "C"), .Cells(LastR, "C")).Value
End With
With CreateObject("scripting.dictionary")
  For i = 1 To UBound(Arr)
    If Mid(Sarr(i, 1), 15, 2) = "79" Or Mid(Sarr(i, 1), 15, 2) = "88" Then
      Sarr(i, 1) = Mid(Sarr(i, 1), 1, 14) & Mid(Sarr(i, 1), 17, 100)
    End If
    If Arr(i, 1) <> "" Then
      tmp = "C" & CStr(Arr(i, 1))
      If Not .exists(tmp) Then .Add (tmp), i
    End If
    If Arr(i, 2) <> "" Then
      tmp = "B" & CStr(Arr(i, 2))
      If Not .exists(tmp) Then .Add (tmp), i
    End If
  Next i
  ReDim Arr(1 To UBound(Arr), 1 To 2)
  For i = 1 To UBound(Darr)
    If Darr(i, 1) <> "" Then
      k = 0
      tmp = "B" & CStr(Darr(i, 1))
      If .exists(tmp) Then ' neu BARCODE thoa dieu kien thì lay 2 cot J và K
        k = .Item(tmp)
        Arr(k, 1) = Darr(i, 5)
        Arr(k, 2) = Darr(i, 6)
      Else
        tmp = "C" & CStr(Darr(i, 1))
        If .exists(tmp) Then ' neu CODE thoa dieu kien thì chi lay cot K
          k = .Item(tmp)
          Arr(k, 2) = Darr(i, 6)
        End If
      End If
    End If
  Next i
End With
With Sheets("t1")
  LastR = .Range("B" & Rows.Count).End(xlUp).Row
  .Range("J" & iR + 1).Resize(UBound(Arr), 2) = Arr
  .Range("C" & iR + 1).Resize(UBound(Arr)) = Sarr
  .Range(.Cells(iR + 1, "T"), .Cells(LastR, "U")).ClearContents
  .Range(.Cells(iR + 1, "L"), .Cells(LastR, "M")).NumberFormat = "#,###"
  .Range(.Cells(iR + 1, "Q"), .Cells(LastR, "S")).NumberFormat = "#,###"
End With
End Sub
 
Upvote 0
HieuCD đã viết:
lúc đầu bỏ sao bậy giờ lại tiếc giữ lại?
cột T và U mình đã xóa bằng lệnh
Mã: 
.Range(.Cells(iR + 1, "T"), .Cells(LastR, "U")).ClearContents
trong code điều kiện lấy dữ liêu mình còn lấn cấn chưa chắc đúng ý bạn
Mã: 
Sub GhepT3T5()
Dim Darr(), Sarr(), Arr(), LastR As Long, iR As Long
iR = Sheets("t1").Range("B" & Rows.Count).End(xlUp).Row
With Sheets("t5")
  LastR = .Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("A2:T" & LastR).Value
    Sheets("t1").Range("D" & iR + 1).Resize(UBound(Darr), 2).NumberFormat = "@"
    Sheets("t1").Range("B" & iR + 1).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
  End If
End With
With Sheets("t23")
  LastR = .Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("A2:T" & LastR).Value
    LastR = Sheets("t1").Range("B" & Rows.Count).End(xlUp).Row
    Sheets("t1").Range("D" & LastR + 1).Resize(UBound(Darr), 2).NumberFormat = "@"
    Sheets("t1").Range("B" & LastR + 1).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
  End If
End With
With Sheets("oder dass")
  LastR = .Range("E" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("E2:J" & LastR).Value
  End If
End With
With Sheets("t1")
  LastR = .Range("B" & Rows.Count).End(xlUp).Row
  Arr = .Range(.Cells(iR + 1, "D"), .Cells(LastR, "E")).Value
  Sarr = .Range(.Cells(iR + 1, "C"), .Cells(LastR, "C")).Value
End With
With CreateObject("scripting.dictionary")
  For i = 1 To UBound(Arr)
    If Mid(Sarr(i, 1), 15, 2) = "79" Or Mid(Sarr(i, 1), 15, 2) = "88" Then
      Sarr(i, 1) = Mid(Sarr(i, 1), 1, 14) & Mid(Sarr(i, 1), 17, 100)
    End If
    If Arr(i, 1) <> "" Then
      tmp = "C" & CStr(Arr(i, 1))
      If Not .exists(tmp) Then .Add (tmp), i
    End If
    If Arr(i, 2) <> "" Then
      tmp = "B" & CStr(Arr(i, 2))
      If Not .exists(tmp) Then .Add (tmp), i
    End If
  Next i
  ReDim Arr(1 To UBound(Arr), 1 To 2)
  For i = 1 To UBound(Darr)
    If Darr(i, 1) <> "" Then
      k = 0
      tmp = "B" & CStr(Darr(i, 1))
      If .exists(tmp) Then ' neu BARCODE thoa dieu kien thì lay 2 cot J và K
        k = .Item(tmp)
        Arr(k, 1) = Darr(i, 5)
        Arr(k, 2) = Darr(i, 6)
      Else
        tmp = "C" & CStr(Darr(i, 1))
        If .exists(tmp) Then ' neu CODE thoa dieu kien thì chi lay cot K
          k = .Item(tmp)
          Arr(k, 2) = Darr(i, 6)
        End If
      End If
    End If
  Next i
End With
With Sheets("t1")
  LastR = .Range("B" & Rows.Count).End(xlUp).Row
  .Range("J" & iR + 1).Resize(UBound(Arr), 2) = Arr
  .Range("C" & iR + 1).Resize(UBound(Arr)) = Sarr
  .Range(.Cells(iR + 1, "T"), .Cells(LastR, "U")).ClearContents
  .Range(.Cells(iR + 1, "L"), .Cells(LastR, "M")).NumberFormat = "#,###"
  .Range(.Cells(iR + 1, "Q"), .Cells(LastR, "S")).NumberFormat = "#,###"
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Anh ơi ban đầu em muốn những code định dạng lỗi #NA là khoảng trắng để lọc dữ liệu nhưng sau em xem lại thì cần code lỗi #NA để kiểm tra phục vụ công việc đó Anh.
Anh ơi cho em hỏi Anh còn lấn cấn điều gì Anh?
Em cảm ơn Anh Hiếu nhiều !
 
Upvote 0
huonglien1901 đã viết:
Anh ơi ban đầu em muốn những code định dạng lỗi #NA là khoảng trắng để lọc dữ liệu nhưng sau em xem lại thì cần code lỗi #NA để kiểm tra phục vụ công việc đó Anh.
Anh ơi cho em hỏi Anh còn lấn cấn điều gì Anh?
Em cảm ơn Anh Hiếu nhiều !
Nhấp chuột vào đây để mở rộng...
ở chổ mình ghi chú trong code, không biết có đúng với điều kiện của bạn không
 
Upvote 0
HieuCD đã viết:
ở chổ mình ghi chú trong code, không biết có đúng với điều kiện của bạn không
Nhấp chuột vào đây để mở rộng...
Anh ơi em test code của Anh bị lỗi những dòng này(em có tô màu vàng nhận biết đó Anh), những dòng này bị lệch cột.
Cột S(DATE OF DATA), CỘT T(SEQ ) chưa xóa cột đó Anh.
CỘT I,J chưa lấy dữ liệu bên sheet Oderdass.
Đây là file em làm bắng tay sử dụng công thức.gopfile.xlsb
code của anh em kiểm tra lưu lại file có tên gopfile1.xlsb
mà anh ơi choe hỏi để giảm dung lượng bộ nhớ của file thì làm cách nào?
Em cảm ơn Anh nhiều!
 

File đính kèm

Upvote 0
huonglien1901 đã viết:
Anh ơi em test code của Anh bị lỗi những dòng này(em có tô màu vàng nhận biết đó Anh), những dòng này bị lệch cột.
Cột S(DATE OF DATA), CỘT T(SEQ ) chưa xóa cột đó Anh.
CỘT I,J chưa lấy dữ liệu bên sheet Oderdass.
Đây là file em làm bắng tay sử dụng công thức.gopfile.xlsb
code của anh em kiểm tra lưu lại file có tên gopfile1.xlsb
mà anh ơi choe hỏi để giảm dung lượng bộ nhớ của file thì làm cách nào?
Em cảm ơn Anh nhiều!
Nhấp chuột vào đây để mở rộng...
file mới và file trước lệch nhau 1 nên chạy code lệch cột là đúng rồi, cột I, và j với điều kiện theo file txt không thỏa nên không lấy, dữ liệu trước thì lấy được
Mã: 
Sub GhepT3T5()
Dim Darr(), Sarr(), Arr(), LastR As Long, iR As Long
iR = Sheets("t1").Range("B" & Rows.Count).End(xlUp).Row
With Sheets("t5")
  LastR = .Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("A2:T" & LastR).Value
    Sheets("t1").Range("D" & iR + 1).Resize(UBound(Darr), 2).NumberFormat = "@"
    Sheets("t1").Range("A" & iR + 1).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
  End If
End With
With Sheets("t23")
  LastR = .Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("A2:T" & LastR).Value
    LastR = Sheets("t1").Range("B" & Rows.Count).End(xlUp).Row
    Sheets("t1").Range("D" & LastR + 1).Resize(UBound(Darr), 2).NumberFormat = "@"
    Sheets("t1").Range("A" & LastR + 1).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
  End If
End With
With Sheets("oder dass")
  LastR = .Range("E" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("E2:J" & LastR).Value
  End If
End With
With Sheets("t1")
  LastR = .Range("B" & Rows.Count).End(xlUp).Row
  Arr = .Range(.Cells(2, "C"), .Cells(LastR, "D")).Value
  Sarr = .Range(.Cells(2, "B"), .Cells(LastR, "B")).Value
End With
With CreateObject("scripting.dictionary")
  For i = 1 To UBound(Arr)
    If Mid(Sarr(i, 1), 15, 2) = "79" Or Mid(Sarr(i, 1), 15, 2) = "88" Then
      Sarr(i, 1) = Mid(Sarr(i, 1), 1, 14) & Mid(Sarr(i, 1), 17, 100)
    End If
    If Arr(i, 1) <> "" Then
      tmp = "C" & CStr(Arr(i, 1))
      If Not .exists(tmp) Then .Add (tmp), i
    End If
    If Arr(i, 2) <> "" Then
      tmp = "B" & CStr(Arr(i, 2))
      If Not .exists(tmp) Then .Add (tmp), i
    End If
  Next i
  ReDim Arr(1 To UBound(Arr), 1 To 2)
  For i = 1 To UBound(Darr)
    If Darr(i, 1) <> "" Then
      k = 0
      tmp = "B" & CStr(Darr(i, 1))
      If .exists(tmp) Then ' neu BARCODE thoa dieu kien thì lay 2 cot J và K
        k = .Item(tmp)
        Arr(k, 1) = Darr(i, 5)
        Arr(k, 2) = Darr(i, 6)
      Else
        tmp = "C" & CStr(Darr(i, 1))
        If .exists(tmp) Then ' neu CODE thoa dieu kien thì chi lay cot K
          k = .Item(tmp)
          Arr(k, 2) = Darr(i, 6)
        End If
      End If
    End If
  Next i
End With
With Sheets("t1")
  LastR = .Range("B" & Rows.Count).End(xlUp).Row
  .Range("I" & 2).Resize(UBound(Arr), 2) = Arr
  .Range("B" & iR + 1).Resize(UBound(Arr)) = Sarr
  .Range(.Cells(2, "S"), .Cells(LastR, "T")).ClearContents
  .Range(.Cells(2, "K"), .Cells(LastR, "L")).NumberFormat = "#,###"
  .Range(.Cells(2, "P"), .Cells(LastR, "R")).NumberFormat = "#,###"
End With
End Sub
 
Upvote 0
HieuCD đã viết:
file mới và file trước lệch nhau 1 nên chạy code lệch cột là đúng rồi, cột I, và j với điều kiện theo file txt không thỏa nên không lấy, dữ liệu trước thì lấy được
Mã: 
Sub GhepT3T5()
Dim Darr(), Sarr(), Arr(), LastR As Long, iR As Long
iR = Sheets("t1").Range("B" & Rows.Count).End(xlUp).Row
With Sheets("t5")
  LastR = .Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("A2:T" & LastR).Value
    Sheets("t1").Range("D" & iR + 1).Resize(UBound(Darr), 2).NumberFormat = "@"
    Sheets("t1").Range("A" & iR + 1).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
  End If
End With
With Sheets("t23")
  LastR = .Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("A2:T" & LastR).Value
    LastR = Sheets("t1").Range("B" & Rows.Count).End(xlUp).Row
    Sheets("t1").Range("D" & LastR + 1).Resize(UBound(Darr), 2).NumberFormat = "@"
    Sheets("t1").Range("A" & LastR + 1).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
  End If
End With
With Sheets("oder dass")
  LastR = .Range("E" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then
    Darr = .Range("E2:J" & LastR).Value
  End If
End With
With Sheets("t1")
  LastR = .Range("B" & Rows.Count).End(xlUp).Row
  Arr = .Range(.Cells(2, "C"), .Cells(LastR, "D")).Value
  Sarr = .Range(.Cells(2, "B"), .Cells(LastR, "B")).Value
End With
With CreateObject("scripting.dictionary")
  For i = 1 To UBound(Arr)
    If Mid(Sarr(i, 1), 15, 2) = "79" Or Mid(Sarr(i, 1), 15, 2) = "88" Then
      Sarr(i, 1) = Mid(Sarr(i, 1), 1, 14) & Mid(Sarr(i, 1), 17, 100)
    End If
    If Arr(i, 1) <> "" Then
      tmp = "C" & CStr(Arr(i, 1))
      If Not .exists(tmp) Then .Add (tmp), i
    End If
    If Arr(i, 2) <> "" Then
      tmp = "B" & CStr(Arr(i, 2))
      If Not .exists(tmp) Then .Add (tmp), i
    End If
  Next i
  ReDim Arr(1 To UBound(Arr), 1 To 2)
  For i = 1 To UBound(Darr)
    If Darr(i, 1) <> "" Then
      k = 0
      tmp = "B" & CStr(Darr(i, 1))
      If .exists(tmp) Then ' neu BARCODE thoa dieu kien thì lay 2 cot J và K
        k = .Item(tmp)
        Arr(k, 1) = Darr(i, 5)
        Arr(k, 2) = Darr(i, 6)
      Else
        tmp = "C" & CStr(Darr(i, 1))
        If .exists(tmp) Then ' neu CODE thoa dieu kien thì chi lay cot K
          k = .Item(tmp)
          Arr(k, 2) = Darr(i, 6)
        End If
      End If
    End If
  Next i
End With
With Sheets("t1")
  LastR = .Range("B" & Rows.Count).End(xlUp).Row
  .Range("I" & 2).Resize(UBound(Arr), 2) = Arr
  .Range("B" & iR + 1).Resize(UBound(Arr)) = Sarr
  .Range(.Cells(2, "S"), .Cells(LastR, "T")).ClearContents
  .Range(.Cells(2, "K"), .Cells(LastR, "L")).NumberFormat = "#,###"
  .Range(.Cells(2, "P"), .Cells(LastR, "R")).NumberFormat = "#,###"
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Vậy trường hợp này làm sao Anh?
Anh có thể làm trong file gủi lên được không Anh?
 
Upvote 0
HieuCD đã viết:
bạn chép code vào file mới và chạy thử xem sao
Nhấp chuột vào đây để mở rộng...
nó bị lệch dòng này!
Nhờ Anh giúp em vẫn giữ định dạng lỗi #NA đó Anh.

Tại file khi sử dụng code lên 6.03M luôn Anh? Có gì file gopfile1.xlsb em gửi lên đó.
Em cảm ơn Anh nhiều!
upload_2017-6-4_22-52-8.png
upload_2017-6-4_22-51-32.png
 
Upvote 0
huonglien1901 đã viết:
Em cảm ơn Anh nhiều!

Nhờ Anh giúp em vẫn giữ định dạng lỗi#NA được không Anh khi không tìm thấy dữ liệu, Thì code sẽ thay đổi như thế nào Anh ơi.
Nhấp chuột vào đây để mở rộng...
Thêm hàm IIf vào, nếu rỗng thì ghi #N/A, ngược lại không rỗng thì lấy giá trị của chính nó.

Mã: 
Sub LayDL()
    Dim v, strPath, strSQL As String
    v = Application.Version
    strPath = ThisWorkbook.FullName
    strSQL = "SELECT [t1$].SITE, [t1$].CEXT, [t1$].CODE, [t1$].BARCODE, [t1$].SU, [t1$].LV, [t1$].[Article Status], [t1$].DESCRIPTION, iif(isnull([oder dass$].SUPCOD),'#N/A',[oder dass$].SUPCOD), iif(isnull([oder dass$].SUPPLIER),'#N/A',[oder dass$].SUPPLIER), Val([t1$].[SKU quantity]) AS [SKU quantity], Val([t1$].[Weight/SKU]) AS [Weight/SKU], [t1$].[Unit purchase price], [t1$].[Unit Cost Price], [t1$].[Unit Sales Price], Val([t1$].[Purchase Stock Value]) AS [Purchase Stock Value], Val([t1$].[Stock Cost Value]) AS [Stock Cost Value], Val([t1$].[Sales Stock Value]) AS [Sales Stock Value] FROM [t1$] LEFT JOIN [oder dass$] ON [t1$].BARCODE = [oder dass$].BARCODE where mid([CEXT],15,2) not in (79,88) " & vbCrLf
    strSQL = strSQL & "union all SELECT [t5$].SITE, [t5$].CEXT, [t5$].CODE, [t5$].BARCODE, [t5$].SU, [t5$].LV, [t5$].[Article Status], [t5$].DESCRIPTION, iif(isnull([oder dass$].SUPCOD),'#N/A',[oder dass$].SUPCOD), iif(isnull([oder dass$].SUPPLIER),'#N/A',[oder dass$].SUPPLIER), Val([t5$].[SKU quantity]) AS [SKU quantity], Val([t5$].[Weight/SKU]) AS [Weight/SKU], [t5$].[Unit purchase price], [t5$].[Unit Cost Price], [t5$].[Unit Sales Price], Val([t5$].[Purchase Stock Value]) AS [Purchase Stock Value], Val([t5$].[Stock Cost Value]) AS [Stock Cost Value], Val([t5$].[Sales Stock Value]) AS [Sales Stock Value] FROM [t5$] LEFT JOIN [oder dass$] ON [t5$].BARCODE = [oder dass$].BARCODE where mid([CEXT],15,2) not in (79,88) " & vbCrLf
    strSQL = strSQL & "union all SELECT [t23$].SITE, [t23$].CEXT, [t23$].CODE, [t23$].BARCODE, [t23$].SU, [t23$].LV, [t23$].[Article Status], [t23$].DESCRIPTION, iif(isnull([oder dass$].SUPCOD),'#N/A',[oder dass$].SUPCOD), iif(isnull([oder dass$].SUPPLIER),'#N/A',[oder dass$].SUPPLIER), Val([t23$].[SKU quantity]) AS [SKU quantity], Val([t23$].[Weight/SKU]) AS [Weight/SKU], [t23$].[Unit purchase price], [t23$].[Unit Cost Price], [t23$].[Unit Sales Price], Val([t23$].[Purchase Stock Value]) AS [Purchase Stock Value], Val([t23$].[Stock Cost Value]) AS [Stock Cost Value], Val([t23$].[Sales Stock Value]) AS [Sales Stock Value] FROM [t23$] LEFT JOIN [oder dass$] ON [t23$].BARCODE = [oder dass$].BARCODE where mid([CEXT],15,2) not in (79,88) " & vbCrLf
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & strPath & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
        Sheet5.Range("A2:V65000").ClearContents
        Sheet5.Range("A2").CopyFromRecordset .Execute(strSQL)
    End With
End Sub
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Thêm hàm IIf vào, nếu rỗng thì ghi #N/A, ngược lại không rỗng thì lấy giá trị của chính nó.

Mã: 
Sub LayDL()
    Dim v, strPath, strSQL As String
    v = Application.Version
    strPath = ThisWorkbook.FullName
    strSQL = "SELECT [t1$].SITE, [t1$].CEXT, [t1$].CODE, [t1$].BARCODE, [t1$].SU, [t1$].LV, [t1$].[Article Status], [t1$].DESCRIPTION, iif(isnull([oder dass$].SUPCOD),'#N/A',[oder dass$].SUPCOD), iif(isnull([oder dass$].SUPPLIER),'#N/A',[oder dass$].SUPPLIER), Val([t1$].[SKU quantity]) AS [SKU quantity], Val([t1$].[Weight/SKU]) AS [Weight/SKU], [t1$].[Unit purchase price], [t1$].[Unit Cost Price], [t1$].[Unit Sales Price], Val([t1$].[Purchase Stock Value]) AS [Purchase Stock Value], Val([t1$].[Stock Cost Value]) AS [Stock Cost Value], Val([t1$].[Sales Stock Value]) AS [Sales Stock Value] FROM [t1$] LEFT JOIN [oder dass$] ON [t1$].BARCODE = [oder dass$].BARCODE where mid([CEXT],15,2) not in (79,88) " & vbCrLf
    strSQL = strSQL & "union all SELECT [t5$].SITE, [t5$].CEXT, [t5$].CODE, [t5$].BARCODE, [t5$].SU, [t5$].LV, [t5$].[Article Status], [t5$].DESCRIPTION, iif(isnull([oder dass$].SUPCOD),'#N/A',[oder dass$].SUPCOD), iif(isnull([oder dass$].SUPPLIER),'#N/A',[oder dass$].SUPPLIER), Val([t5$].[SKU quantity]) AS [SKU quantity], Val([t5$].[Weight/SKU]) AS [Weight/SKU], [t5$].[Unit purchase price], [t5$].[Unit Cost Price], [t5$].[Unit Sales Price], Val([t5$].[Purchase Stock Value]) AS [Purchase Stock Value], Val([t5$].[Stock Cost Value]) AS [Stock Cost Value], Val([t5$].[Sales Stock Value]) AS [Sales Stock Value] FROM [t5$] LEFT JOIN [oder dass$] ON [t5$].BARCODE = [oder dass$].BARCODE where mid([CEXT],15,2) not in (79,88) " & vbCrLf
    strSQL = strSQL & "union all SELECT [t23$].SITE, [t23$].CEXT, [t23$].CODE, [t23$].BARCODE, [t23$].SU, [t23$].LV, [t23$].[Article Status], [t23$].DESCRIPTION, iif(isnull([oder dass$].SUPCOD),'#N/A',[oder dass$].SUPCOD), iif(isnull([oder dass$].SUPPLIER),'#N/A',[oder dass$].SUPPLIER), Val([t23$].[SKU quantity]) AS [SKU quantity], Val([t23$].[Weight/SKU]) AS [Weight/SKU], [t23$].[Unit purchase price], [t23$].[Unit Cost Price], [t23$].[Unit Sales Price], Val([t23$].[Purchase Stock Value]) AS [Purchase Stock Value], Val([t23$].[Stock Cost Value]) AS [Stock Cost Value], Val([t23$].[Sales Stock Value]) AS [Sales Stock Value] FROM [t23$] LEFT JOIN [oder dass$] ON [t23$].BARCODE = [oder dass$].BARCODE where mid([CEXT],15,2) not in (79,88) " & vbCrLf
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & strPath & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
        Sheet5.Range("A2:V65000").ClearContents
        Sheet5.Range("A2").CopyFromRecordset .Execute(strSQL)
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Anh Hai Lúa nó lấy 2 lần luôn Anh Ơi.
Em tải file nhờ Anh xem giúp.
Em cảm ơn Anh nhiều!
upload_2017-6-5_9-24-24.png
 

File đính kèm

Upvote 0
Upvote 0
huonglien1901 đã viết:
Code quá tuyệt vời Bác ơi., Nhờ Bác tạo cho em nút xóa dữ liệu được không Bác, ở sheet GPE mà bác tạo cho em.
Em cảm ơn Bác nhiều!
Chúc Bác ngày đầu tuần vui vẻ.
Nhấp chuột vào đây để mở rộng...
Trong code có lệnh xóa trước khi gán dữ liệu mới rồi?
PHP: 
With Sheets("GPE")
    .Range("A3:B60000").Resize(, 18).ClearContents
    .Range("A3").Resize(K, 18) = dArr
End With
Bạn cứ tạo một cái nút rồi gán cái Sub này cho nó.
PHP: 
Public Sub XOA()
Sheets("GPE").Range("A3:R60000").ClearContents
End Sub
 
Upvote 0
Upvote 0
Upvote 0
huonglien1901 đã viết:
Trong hai dòng này chỉ lấy 01 thôi anh ơi, dựa vào điều kiện Cột BARCODE và cột CODe đó Anh. Anh có thể loại bỏ trùng dữ liệu được không Anh? Nếu khi lọc dữ liệu trùng thì được kết quả là 33257 dòng.

Em cảm ơn Anh!
Nhấp chuột vào đây để mở rộng...
Thông thường người ta sẽ làm 1 bảng thông tin nhà cung cấp riêng, chứ không làm chung như vậy.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

dongbhhg
Tìm lương cơ sở theo từng tháng (4 người xem)
Trả lời
0
Đọc
1
dongbhhg
dongbhhg
tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác (2 người xem)
Trả lời
6
Đọc
174
thuytrangbp28
T
V
Làm mẫu giấy đi đường (công lệnh) bằng Excel (3 người xem)
Trả lời
10
Đọc
11K
SA_DQ
SA_DQ
H
Quản Lý Công Văn đi Và đến (1 người xem)
9 10 11
Trả lời
215
Đọc
159K
hamhochoi66
H
B
Xin hướng dẫn cách để hàm Xlookup tự hiển thị theo số dòng có chứa điều kiện tìm kiếm ko dùng VBA (1 người xem)
Trả lời
9
Đọc
118
thuytrangbp28
T
V
Help: Hàm đếm lọc giá trị trùng (1 người xem)
    • Cười
Trả lời
17
Đọc
124
SA_DQ
SA_DQ
K
Hỏi lỗi không kéo được công thức (Ctrl+D)
Trả lời
6
Đọc
73
HeSanbi
HeSanbi
R
Chuyển count thành sum khi pivot (1 người xem)
Trả lời
4
Đọc
8K
ptm0412
ptm0412
T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
    • Cười
Trả lời
2
Đọc
84
TramAnhNguyen692
T
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
15
Đọc
239
thuytrangbp28
T
S
NHỜ ANH EM GIÚP MÌNH TÌM KIẾM DỮ LIỆU
Trả lời
12
Đọc
145
sangdennh
S
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng,
Trả lời
9
Đọc
76
hanhnguyen12022021
H
C
Filter có điều kiện đang ở dạng Cột (1 người xem)
Trả lời
2
Đọc
71
thuytrangbp28
T
L
Có ai biết fix lỗi này không ạ
    • Buồn
Trả lời
2
Đọc
56
lekimhuy0812
L
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365 (1 người xem)
    • Thích
Trả lời
1
Đọc
3K
PhanTuHuong
PhanTuHuong
K
Lỗi cấu trúc hình ảnh khi mở file bằng điện thoại
Trả lời
0
Đọc
39
Kecodonlalala
K
N
  • Question Question
Nhờ mọi người góp ý cho file Quản lý bán hàng viết bằng VBA đầu tay của mình
    • Cảm ơn
    • Thích
Trả lời
7
Đọc
169
newbiexo
N
H
Xin được trợ giúp lỗi máy không mở được cửa sổ VBE.
Trả lời
3
Đọc
69
Nguyễn Duy Tuân
Nguyễn Duy Tuân
HeSanbi
  • Question Question
Sự khác nhau giữa book.Worksheets và book.Sheets trong Application (1 người xem)
    • Thích
Trả lời
2
Đọc
153
Nguyễn Duy Tuân
Nguyễn Duy Tuân
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :) (1 người xem)
    • Thích
    • Yêu thích
Trả lời
7
Đọc
336
PhanTuHuong
PhanTuHuong
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom