GỘP FILE VÀ TỔNG HỢP DỮ LIỆU! (2 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:
1. Xóa bỏ Cột A trong file t1.
2. 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.
Nhấp chuột vào đây để mở rộng...
1. Dữ liệu bắt đầu của Sheet t1 nằm ở B1, Sao không cho nó nằm tại cell A1 mà phải nằm ở B1, khi copy dữ liệu xong rồi xóa cột A, vì cột A là trống?
2. Chưa hiểu cách diễn đạt này.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
1. Dữ liệu bắt đầu của Sheet t1 nằm ở B1, Sao không cho nó nằm tại cell A1 mà phải nằm ở B1, khi copy dữ liệu xong rồi xóa cột A, vì cột A là trống?
2. Chưa hiểu cách diễn đạt này.
Nhấp chuột vào đây để mở rộng...
Như thế này Anh ơi, Dữ liệu em xuất trên phần mềm ra đó Anh, Nó xuất ra ở ô B1 nên cột A bỏ trống,, cột A này dùng công thức để lấy ra số 79,88 rồi xóa những số này đi.

Em cảm ơn Anh.
 
Upvote 0
huonglien1901 đã viết:
Như thế này Anh ơi, Dữ liệu em xuất trên phần mềm ra đó Anh, Nó xuất ra ở ô B1 nên cột A bỏ trống,, cột A này dùng công thức để lấy ra số 79,88 rồi xóa những số này đi.

Em cảm ơn Anh.
Nhấp chuột vào đây để mở rộng...
79,88 là sao? mid(cột Cext,15,2) thì làm sao ra kết quả là 5 kí tự? Lấy xong rồi xóa là sao?
 
Upvote 0
Upvote 0
huonglien1901 đã viết:
Anh ơi nó lấy ra hai kí tự mà anh, Hai kí tự này là mã hàng kí gủi nên loại bỏ đí.
Nhấp chuột vào đây để mở rộng...
Vậy 79,88 là gì bạn? Nói chung bây giờ yêu cầu của bạn là cần lấy 2 kí tự trong cột Cext dựa vào hàm mid(cột Cext,15,2)? Tôi không hiểu xóa nó đi?
 
Upvote 0
huonglien1901 đã viết:
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!
Nhấp chuột vào đây để mở rộng...
Quen biết đã lâu nhưng vẫn không thể hiểu ý nhau:
_ "mid(cột Cext,15,2) rồi xóa 79,88 đi." không thấy các số nầy?
_ "Nếu không tìm thấy hoặc lỗi #NA thì gán giá trị rỗng." ai bị lỗi #NA ???
dùng tạm code
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
End With
With CreateObject("scripting.dictionary")
  For i = 1 To UBound(Arr)
    If Arr(i, 1) <> "" Then
      tmp = "C" & Arr(i, 1)
      If Not .exists(tmp) Then .Add (tmp), i
    End If
    If Arr(i, 2) <> "" Then
      tmp = "B" & 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" & 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" & 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(.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
Hai Lúa Miền Tây đã viết:
Vậy 79,88 là gì bạn? Nói chung bây giờ yêu cầu của bạn là cần lấy 2 kí tự trong cột Cext dựa vào hàm mid(cột Cext,15,2)? Tôi không hiểu xóa nó đi?
Nhấp chuột vào đây để mở rộng...
Đúng rồi Anh! Mã 79,88 là mã hàng kí gửi, em muốn xóa bỏ những dòng có chứa kí tự số này, vì em làm môi trường siêu thị nên em phải loại bỏ nó đi vì sẽ đưa vào sẽ tính sai.
À Anh, Anh nói đúng chỉ cần đưa dữ liệu vào ô A1 thôi, em gửi lại file nhé!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
huonglien1901 đã viết:
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!
Nhấp chuột vào đây để mở rộng...
thì cứ record macro thao tác bạn làm bằng tay sau đó là sẽ có kết quả thôi.
 
Upvote 0
HieuCD đã viết:
Quen biết đã lâu nhưng vẫn không thể hiểu ý nhau:
_ "mid(cột Cext,15,2) rồi xóa 79,88 đi." không thấy các số nầy?
_ "Nếu không tìm thấy hoặc lỗi #NA thì gán giá trị rỗng." ai bị lỗi #NA ???
dùng tạm code
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
End With
With CreateObject("scripting.dictionary")
  For i = 1 To UBound(Arr)
    If Arr(i, 1) <> "" Then
      tmp = "C" & Arr(i, 1)
      If Not .exists(tmp) Then .Add (tmp), i
    End If
    If Arr(i, 2) <> "" Then
      tmp = "B" & 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" & 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" & 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(.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...
"mid(cột Cext,15,2) rồi xóa 79,88 đi." không thấy các số nầy?
Anh copy file t5 vào t1, t23 vào t1 , Anh dùng hàm mid(cột CEXT,15,2) rồi anh fillthì sẽ thấy 79,88.
"Nếu không tìm thấy hoặc lỗi #NA thì gán giá trị rỗng." ai bị lỗi #NA ???


Câu này có ý nghĩa là dựa vào điều kiện Cột E bên sheet T1 để dò kết quả bên sheet Oderdass của côtJ
Trường hợp không tìm thấy lần 1 thì dựa vào cột D bên sheet t1 để dò kết quả bên sheet Oderdass của cột J,
Trường hợp không tìm thấy dữ liệu hoặc lỗi dữ liệu #NA thì gán giá trị rỗng.
Em diễn đạt như thế này Anh hiểu chưa?
Code của Anh nó chạy copy hai file t5 và t23 vào t1 rồi,
Code Anh chưa xoa những dòng có kí tự 79,88.
Code Anh chưa lấy dữ liệu ở cột J, và cột K.
Em Chúc anh ngày vui.
 
Lần chỉnh sửa cuối:
Upvote 0
huonglien1901 đã viết:
mid(cột Cext,15,2) rồi xóa 79,88 đi." không thấy các số nầy?
Nhấp chuột vào đây để mở rộng...
Trời ạ, tôi tưởng kết quả nó ra là số 79,88 (5 kí tự) chứ không phải là số 79 và số 88. Có nghĩa là bạn chỉ cần lấy những dòng không thỏa điều kiện là trong cột Cext dùng hàm mid(cột Cext,15,2) không có số 79 và số 88 phải không?
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Trời ạ, tôi tưởng kết quả nó ra là số 79,88 (5 kí tự) chứ không phải là số 79 và số 88. Có nghĩa là bạn chỉ cần lấy những dòng không thỏa điều kiện là trong cột Cext dùng hàm mid(cột Cext,15,2) không có số 79 và số 88 phải không?
Nhấp chuột vào đây để mở rộng...
Dạ đúng rồi Anh, Hàm Mid(cột CEXT,15,2) lấy ra hai kí tự mà Anh?
 
Upvote 0
Upvote 0
huonglien1901 đã viết:
DẠ, Vậy Anh có thể hỗ trợ em được không?
Nhấp chuột vào đây để mở rộng...
ADO không xóa dòng dữ liệu trực tiếp trên Excel. Nếu bạn muốn theo cách là tạo Sheet mới gọi là sheet kết quả, sheet kết quả này sẽ tổng hợp 3 sheet T1, T5 và T23 rồi "xào nấu" để ghi ra kết quả.
Nếu bạn đồng ý thì ta đi tiếp nhé.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
ADO không xóa dòng dữ liệu trực tiếp trên Excel. Nếu bạn muốn theo cách là tạo Sheet mới gọi là sheet kết quả, sheet kết quả này sẽ tổng hợp 3 sheet T1, T5 và T23 rồi "xào nấu" để ghi ra kết quả.
Nếu bạn đồng ý thì ta đi tiếp nhé.
Nhấp chuột vào đây để mở rộng...
Dạ được Anh.
 
Upvote 0
huonglien1901 đã viết:
"mid(cột Cext,15,2) rồi xóa 79,88 đi." không thấy các số nầy?
Anh copy file t5 vào t1, t23 vào t1 , Anh dùng hàm mid(cột CEXT,15,2) rồi anh fillthì sẽ thấy 79,88.
"Nếu không tìm thấy hoặc lỗi #NA thì gán giá trị rỗng." ai bị lỗi #NA ???


Câu này có ý nghĩa là dựa vào điều kiện Cột E bên sheet T1 để dò kết quả bên sheet Oderdass của côtJ
Trường hợp không tìm thấy lần 1 thì dựa vào cột D bên sheet t1 để dò kết quả bên sheet Oderdass của cột J,
Trường hợp không tìm thấy dữ liệu hoặc lỗi dữ liệu #NA thì gán giá trị rỗng.
Em diễn đạt như thế này Anh hiểu chưa?
Code của Anh nó chạy copy hai file t5 và t23 vào t1 rồi,
Code Anh chưa xoa những dòng có kí tự 79,88.
Code Anh chưa lấy dữ liệu ở cột J, và cột K.
Em Chúc anh ngày vui.
Nhấp chuột vào đây để mở rộng...
đã 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
 
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...
dạ giờ em phải đi làm có gì tối về em gửi file cho anh nghe,
Em chúc Anh buổi trưa ngon miệng!
 
Upvote 0
huonglien1901 đã viết:
Dạ được Anh.
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

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

tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác (1 người xem)
Trả lời
6
Đọc
173
thuytrangbp28
T
V
Làm mẫu giấy đi đường (công lệnh) bằng Excel (4 người xem)
Trả lời
10
Đọc
11K
SA_DQ
SA_DQ
H
Quản Lý Công Văn đi Và đến (2 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
116
thuytrangbp28
T
V
Help: Hàm đếm lọc giá trị trùng
    • Cười
Trả lời
17
Đọc
123
SA_DQ
SA_DQ
K
Hỏi lỗi không kéo được công thức (Ctrl+D) (1 người xem)
Trả lời
6
Đọc
71
HeSanbi
HeSanbi
R
Chuyển count thành sum khi pivot
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 (1 người xem)
Trả lời
15
Đọc
238
thuytrangbp28
T
S
NHỜ ANH EM GIÚP MÌNH TÌM KIẾM DỮ LIỆU (2 người xem)
Trả lời
12
Đọc
144
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
Trả lời
2
Đọc
70
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
    • 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 (1 người xem)
    • 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
    • Thích
Trả lời
2
Đọc
152
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 :)
    • Thích
    • Yêu thích
Trả lời
7
Đọc
336
PhanTuHuong
PhanTuHuong
yeudoi
Cà phê giao lưu cùng thành viên kỳ cựu Cao Mạnh Sơn 19h 23/2/2025
    • Thích
    • Yêu thích
Trả lời
1
Đọc
85
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