Thiết lập code cập nhật số lượng theo nhiều điều kiện

[bebeen]

Em đang tạo báo cáo cập nhật số lượng theo nhiều điều kiện. Loay hoay mãi không nghĩ ra giải pháp nên em post lên đây để nhờ mọi người hỗ trợ giúp em nhé!

Câu hỏi cụ thể ở file đính kèm.

Cám ơn mọi người nhiều!

 

[Đừng Lắm Mồm]

Paste code vào sheet3 (BAO CAO)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sArr, dArr, C As Object, I As Long, K As Long, R As Object, N As Long, Col As Long, Rws As Long, Lenh As String, J As Long
If Target.Address = "$B$1" Then
Application.ScreenUpdating = False
sArr = Sheet2.Range("A2").CurrentRegion.Value
Lenh = Target.Value
Set C = CreateObject("Scripting.Dictionary")
Set R = CreateObject("Scripting.Dictionary")
ReDim dArr(1 To UBound(sArr), 1 To 1000)
K = 2: N = 7
dArr(1, 1) = "STT": dArr(1, 2) = "MATHANG": dArr(1, 3) = "TENHANG"
dArr(1, 4) = "DVT": dArr(1, 5) = "SOLUONGTHEOLENH": dArr(1, 6) = "SOLUONGXUAT": dArr(1, 7) = "TON"


For I = 2 To UBound(sArr)
    If sArr(I, 2) = Lenh Then
        If Not R.Exists(sArr(I, 3)) Then
            K = K + 1
            R.Add sArr(I, 3), K
            dArr(K, 1) = K-2
            For J = 2 To 5
                dArr(K, J) = sArr(I, J + 1)
            Next
        Else
            Rws = R.Item(sArr(I, 3))
            dArr(Rws, 5) = dArr(Rws, 5) + sArr(I, 6)
        End If
    End If
Next

sArr = Sheet1.Range("A2").CurrentRegion.Value

For I = 2 To UBound(sArr)
    If sArr(I, 2) = Lenh Then
        If Not C.Exists(sArr(I, 1)) Then
            N = N + 1
            C.Add sArr(I, 1), N
            dArr(1, N) = sArr(I, 3)
            dArr(2, N) = sArr(I, 1)
        End If
        Rws = R.Item(sArr(I, 4))
        Col = C.Item(sArr(I, 1))
        dArr(Rws, 6) = dArr(Rws, 6) + sArr(I, 7)
        dArr(Rws, 7) = "=RC[-2]-RC[-1]"
        dArr(Rws, Col) = dArr(Rws, Col) + sArr(I, 7)
    End If
Next
    If K Then
        Range("A5:A1000").Resize(, 1000).ClearContents
        Range("A5").Resize(K, N).Value = dArr
    End If
Application.ScreenUpdating = True
End If
End Sub

 

[bebeen]

Code rất hay. Bạn có thể giúp mình đoạn code nữa để có dòng cộng tổng cuối nữa thì tốt ạ!

 

[Đừng Lắm Mồm]

Code rất hay. Bạn có thể giúp mình đoạn code nữa để có dòng cộng tổng cuối nữa thì tốt ạ!

If K Then
        Range("A5:A1000").Resize(, 1000).ClearContents
        Range("A5").Resize(K, N).Value = dArr
        Range("B5").Offset(K - 1).Value = "TONG CONG"
        Range("E5").Offset(K - 1).Resize(, N - 4).FormulaR1C1 = "=SUM(R[-" & K - 2 & "]C:R[-1]C)"
End If

 

[Ba Tê]

If K Then
        Range("A5:A1000").Resize(, 1000).ClearContents
        Range("A5").Resize(K, N).Value = dArr
        Range("B5").Offset(K - 1).Value = "TONG CONG"
        Range("E5").Offset(K - 1).Resize(, N - 4).FormulaR1C1 = "=SUM(R[-" & K - 2 & "]C:R[-1]C)"
End If

Bên trên gán K=2 thì K luôn >0
Range("E5").Offset(K - 1) Nếu lấy "E6" thì bớt được 1 phép trừ.
Dữ liệu bắt đầu từ dòng 7 thì: "=SUM(R7C:R[-1]C)"

 

[SA_DQ]

Bạn có thể giúp mình đoạn code nữa để có dòng cộng tổng cuối nữa thì tốt ạ!

Cách khác là ta ấn định sẵn dòng chứa công thức tổng tại dòng Rws + 9; Ở đây Rws là dòng cuối chứa dữ liệu của trang 'DMHH'

Ta chỉ việc cho macro ẩn các dòng không chứa dữ liệu trên dòng đã ấn định này đi thôi.

(Bổ sung file để ai đó cần thêm 1 tham khảo )

 

[quanluu]

Em đang tạo báo cáo cập nhật số lượng theo nhiều điều kiện. Loay hoay mãi không nghĩ ra giải pháp nên em post lên đây để nhờ mọi người hỗ trợ giúp em nhé!

Câu hỏi cụ thể ở file đính kèm.

Cám ơn mọi người nhiều!

Nếu không rành code thì có thể dùng Pivot cho CSDL rồi kết hợp với DMHH. Làm thủ công 3 bước.
1. Pivot cho ra số lượng cột là số phiều và ngày, hàng là mã hàng và tên hàng
2. dùng công thức để lấy định mức tương ứng
3. Xử lý lại sao cho đẹp