Xin giúp đỡ code tách dữ liệu theo ngày tháng (1 người xem)

[LYSM]

Em chào các thầy cô, anh chị!
Em có file dữ liệu muốn tách theo ngày tháng. Cụ thể:
tại sheet "Doso" vùng từ cột A:E là của ngày 29/06/13, vùng này được tách ra từ sheet "So luong" theo CT sau:
=cột J+K-Vlookup(B5:B65000,Z5:AD65000,5,0) của các mã số tương ứng. Trong file đính kèm em có làm code "Doso" nhưng kết quả vẫn không đúng ạ. Cụ thể là phần bôi màu đỏ ấy kết quả vẫn ra đúng yêu cầu, nhưng nếu dòng dưới không có dữ liệu thì nó trừ sai (trường hợp PL003 và PL005), phần màu xanh là phần dữ liệu A4:E8, các mã nào có SL=0 thì loại bỏ khỏi phần tách. Tương tự các ngày khác trong sheet "Doso" cũng làm tương tự như vậy. Mong các thầy cô, anh chị giúp đỡ.
Em cảm ơn nhiều!

Sub Doso()
On Error Resume Next
Dim Arr, Arr1, dArr, sl, i As Long, j As Long, k As Long, n As Long
With Sheets("So luong")
Arr = .Range(.[B5], .[B65000].End(xlUp)).Resize(, 23).Value
Arr1 = .Range(.[Z5], .[Z65000].End(xlUp)).Resize(, 5).Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 35)

For j = 1 To UBound(Arr1, 1)
If UCase(Right(Arr1(j, 1), 6)) = .[J2] Or UCase(Right(Arr1(j, 1), 6)) = .[K2] Then
n = n + 1
dArr(n, 1) = Left(Arr1(j, 1), 5)
dArr(n, 2) = Arr1(j, 5)
dArr(n, 3) = Arr1(j, 2)
dArr(n, 4) = Arr1(j, 3)
dArr(n, 5) = Arr1(j, 4)
End If
Next j
For i = 1 To UBound(Arr, 1)
If Sheet2.[K1] = Sheet1.[A2] And Arr(i, 1) <> "" Then
n = n + 1
dArr(n, 1) = Arr(i, 1)
dArr(n, 6) = WorksheetFunction.VLookup(Arr(i, 1) & "*" & .[J2], Arr1, 5, 0)
dArr(n, 7) = WorksheetFunction.VLookup(Arr(i, 1) & "*" & .[K2], Arr1, 5, 0)
dArr(n, 2) = Arr(i, 9) + Arr(i, 10) - dArr(n, 7) - dArr(n, 6)
End If
If dArr(n, 2) = 0 Then n = n - 1
Next i
Next i

End With
With Sheets("Do so")
.Range("A4:E65000").ClearContents
.[A4].Resize(n, 5) = dArr
End With
End Sub

 

[leonguyenz]

Em chào các thầy cô, anh chị!
Em có file dữ liệu muốn tách theo ngày tháng. Cụ thể:
tại sheet "Doso" vùng từ cột A:E là của ngày 29/06/13, vùng này được tách ra từ sheet "So luong" theo CT sau:
=cột J+K-Vlookup(B5:B65000,Z5:AD65000,5,0) của các mã số tương ứng. Trong file đính kèm em có làm code "Doso" nhưng kết quả vẫn không đúng ạ. Cụ thể là phần bôi màu đỏ ấy, phần màu xanh là phần dữ liệu A4:E8, các mã nào có SL=0 thì loại bỏ khỏi phần tách. Tương tự các ngày khác trong sheet "Doso" cũng làm tương tự như vậy. Mong các thầy cô, anh chị giúp đỡ.
Em cảm ơn nhiều!

Không biết có ai gặp trường hợp như mình không: không tải được file đính kèm ở bài này. Mình đã thử tải file từ các bài khác thì bình thường, còn bài này thì chịu, ai biết cách khắc phục thì chỉ dùm với.

 

[Ba Tê]

Không biết có ai gặp trường hợp như mình không: không tải được file đính kèm ở bài này. Mình đã thử tải file từ các bài khác thì bình thường, còn bài này thì chịu, ai biết cách khắc phục thì chỉ dùm với.

Thử tải bằng file RAR xem sao:

 

[leonguyenz]

Thử tải bằng file RAR xem sao:

Không chỉ mỗi GPE mà các trang khác đều không tải được file nén (rar, zip). Nhờ Mod chuyển sang box phù hợp dùm, và nhờ mọi người hướng dẫn cách khắc phục. Các file khác tải bình thường.
--------------
Híc, tại thằng IDM Thầy Ba Tê ạ, em tắt IDM và khởi động lại thì tải được rồi.
Nhờ BQT xóa dùm bài #2 và #4 ạ.
Cảm ơn!

 

[LYSM]

Nếu làm cho cả mảng không khả thi thì nhờ mọi người sửa giúp em code "Doso" cho đúng yêu cầu ạ. Em cảm ơn nhiều!
Ngày nào em cũng vào xem mà không thấy có ai trả lời, rất mong câu trả lời từ mọi người