Dạ em cám ơn anh nhiều ạ, em sẽ rút kinh nghiệm ạ.
Cảm ơn bạn nhiều, tuy nhiên mỗi một đặc thù công ty có yêu cầu riêng bạn ạ.
Thử với sub khác tí
Option Explicit
Sub XYZ()
Dim sRow&, sR&, i&, j&, k&, ik&, jC&
Dim arr(), td(), Res(), dic As Object
Dim process$, ocNo$, act$, oc$, aName$, iTem$
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
act = "Actual Qty": oc = "OC Qty"
With Sheets("All Data")
arr = .Range("A6:L" & .Cells(Rows.Count, 1).End(3).Row).Value
End With
With Sheets("Form")
td = .Range("C4:V6").Value
ocNo = Range("D3").Value
End With
For j = 2 To UBound(td, 2)
If td(1, j) <> Empty Then process = td(1, j)
dic(process & td(3, j)) = j
Next j
sRow = UBound(arr)
sR = sRow + 4
ReDim Res(1 To sR, 1 To 21)
For i = 2 To sRow
If arr(i, 4) = ocNo Then
If arr(i, 1) = act Then
If Not dic.Exists(arr(i, 3)) Then
k = k + 1
dic.Add arr(i, 3), k
Res(k, 1) = arr(i, 3)
End If
ik = dic(arr(i, 3))
ElseIf arr(i, 1) = oc Then
ik = sR
End If
For j = 10 To 12
If arr(i, j) > 0 Then
jC = dic(arr(i, 2) & arr(1, j))
Res(ik, jC) = Res(ik, jC) + arr(i, j)
If ik < sR Then Res(sR - 1, jC) = Res(sR - 1, jC) + arr(i, j)
End If
Next j
If aName = Empty Then aName = arr(i, 9): iTem = arr(i, 6)
End If
Next i
Res(k + 2, 1) = act: Res(k + 3, 1) = oc
For j = 2 To 21
Res(k + 2, j) = Res(sR - 1, j)
Res(k + 3, j) = Res(sR, j)
Next j
With Sheets("Form")
.Range("C7").Resize(1000, 21).ClearContents
.Range("C7").Resize(k + 3, 21) = Res
.Range("D2") = aName: .Range("F3") = iTem
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End SubLàm đến cỡ code thế này mà còn phải "công ty có yêu cầu riêng"?
Dạ em đa tạ anh ạ, bài toán của em đã được giải đáp gọn gàng ạ. Có một chút xíu là trên sheet Form hình như đang lấy dữ liệu nào nhập trước chứ không tự động Sort ngày tháng từ old đến new ạ. Tuy nhiên cũng đã giải đáp được mong muốn của em rồi. Em cảm ơn anh và mọi người đã tận tình giúp đỡ ạ.
Dạ, em cũng tìm cách giải quyết bài toán mà sếp em yêu cầu ạ nên phải xin nhận sự giúp đỡ của mọi người ạ. Em cảm ơn.
Anh ơi làm ơn cho em hỏi chút, khi em coppy thêm một số sheet vào và nhập dữ liệu vào thì báo lỗi như hình đính kèm, anh chỉ giúp giùm em lỗi khác phục được không ạ.
Lỗi do nhiều nguyên nhân, thường do dữ liệu không chuẩn
Res(ik, jC) = Res(ik, jC) + arr(i, j)
If ik < sR Then Res(sR - 1, jC) = Res(sR - 1, jC) + arr(i, j) If dic.exists(arr(i, 2) & arr(1, j)) Then
jC = dic(arr(i, 2) & arr(1, j))
If IsNumeric(arr(i, j)) Then
arr(i, j) = Val(arr(i, j))
Res(ik, jC) = Res(ik, jC) + arr(i, j)
If ik < sR Then Res(sR - 1, jC) = Res(sR - 1, jC) + arr(i, j)
End If
End IfDạ em cảm ơn nhiều anh nhiều ạ.
