Giúp sửa code: dựa vào sheet khác, tính tổng cho từng nhóm (giống SumProduct) (2 người xem)

[Hong.Van]

Em chào Thầy cô & anh chị
Xin giúp em chỉnh sửa code sau:
Tại Sheet CNT01, Khi chạy code em muốn kết quả tại cột F & G
Dựa vào cột B (mã khách hàng) và cell A7 là mã tháng

Sheet Data là nơi để lấy số liệu

Các mã :131, 331, 1388, 3388 là mã Tổng
Nếu Mã là 131 thì có các mã con có ký tự đầu là B
Nếu Mã là 331 thì có các mã con có ký tự đầu là M
Nếu Mã là 1388 thì có các mã con có ký tự đầu là Y
Nếu Mã là 3388 thì có các mã con có ký tự đầu là Z
-----------
Cthức cho các mã như sau:
Nếu là mã tổng, ví dụ mã 131 thì công thức là
cell F11=SUMPRODUCT((Data!$E$10:$E$255=$A$7)*(Data!$I$10:$I$255=131)*(Data!$K$10:$K$255))
Cell G11=SUMPRODUCT((Data!$E$10:$E$255=$A$7)*(Data!$J$10:$J$255=131)*(Data!$K$10:$K$255))

Nếu là mã con, ví dụ mã BKVL
cell F12=SUMPRODUCT((Data!$E$10:$E$255=$A$7)*(Data!$I$10:$I$255=$B$11)*(Data!$G$10:$G$255=$B12)*(Data!$K$10:$K$255))

Cell G12=SUMPRODUCT((Data!$E$10:$E$255=$A$7)*(Data!$J$10:$J$255=$B$11)*(Data!$G$10:$G$255=$B12)*(Data!$K$10:$K$255))
(Em có công thức ở cột F & G tại Sheet CNT01)

-------------
Dựa vào các cthức trên , em viết code như sau

Sub PhatSinh()    Dim sArray
    Dim i As Long
    Dim n1 As Range, n2 As Range, n3 As Range, n4 As Range, n5 As Range, n6 As Range, n7 As Range, n8 As Range
    Dim B As String, M As String, Y As String, Z As String
    Dim Wf As WorksheetFunction
    Set Wf = WorksheetFunction
    With ActiveSheet
        Set n7 = .Range(.[B11], .[B65536].End(3))
        sArray = n7.Resize(, 6).Value
        Set n8 = .Range(.[A7])


    End With
    With Sheets("Data")
        Set n1 = .Range(.[B10], .[B65536].End(3))
        Set n2 = n1.Offset(, 3)    ' cot E
        Set n3 = n1.Offset(, 5)    ' cot G
        Set n4 = n1.Offset(, 7)    ' cot I
        Set n5 = n1.Offset(, 8)    ' cot J
        Set n6 = n1.Offset(, 9)    ' cot K
         
    End With


    For i = 1 To UBound(sArray, 1)


        If Not IsNumeric(sArray(i, 1)) Then
            If Left(sArray(i, 1), 1) = "B" Then
[COLOR=#ff0000]                sArray(i, 5) = Wf.SumProduct((n2 = n8) * (n3 = sArray(i, 1)) * (n4 = 131) * n6)
                sArray(i, 6) = Wf.SumProduct((n2 = n8) * (n3 = sArray(i, 1)) * (n5 = 131) * n6)[/COLOR]
            End If
        End If
        If IsNumeric(sArray(i, 1)) Then
            If sArray(i, 1) = 131 Then
               [COLOR=#ff0000] sArray(i, 5) = Wf.SumProduct((n2 = n8) * (n4 = 131) * n6)
                sArray(i, 6) = Wf.SumProduct((n2 = n8) * (n5 = 131) * n6)[/COLOR]
            End If
        End If
    Next i
    n7.Resize(, 6).Value = sArray
End Sub

(code trên em chỉ viết tạm cho mã 131 và mã có nhóm có ký tự đầu tiên là B)
Code trên không chạy và báo lỗi (các dòng màu đỏ)
Vui lòng hướng dẫn em chỗ sai
Nếu trường hợp không sửa được thì em nhờ Thầy cô & anh chị viết giúp em code khác dạng như trên
Em cảm ơn!

 

[ndu96081631]

Code trên không chạy và báo lỗi (các dòng màu đỏ)
Vui lòng hướng dẫn em chỗ sai
Nếu trường hợp không sửa được thì em nhờ Thầy cô & anh chị viết giúp em code khác dạng như trên
Em cảm ơn!

Hôm trước tôi đã nói là phải dùng Evaluate rồi cơ mà
WorksheetFunction.SumProduct chỉ dùng với việc tính tổng thông thường thôi (không có điều kiện) --->Còn với yêu cầu tính tổng 2 điều kiện như trên thì phải là Evaluate("SUMPRODUCT(...... )") gì đó mới được

 

[Hong.Van]

Hôm trước tôi đã nói là phải dùng Evaluate rồi cơ mà
WorksheetFunction.SumProduct chỉ dùng với việc tính tổng thông thường thôi (không có điều kiện) --->Còn với yêu cầu tính tổng 2 điều kiện như trên thì phải là Evaluate("SUMPRODUCT(...... )") gì đó mới được

Em đã dùng Evaluate("SUMPRODUCT(...... )") rồi, code bây giờ kg báo lỗi, nhưng khi chạy code thì tất cả cho giá trị bằng 0
Em cũng đã thay thử các điều kiên, nhưng tìm mãi chưa ra, em bó tay nó rồi!
Em nhờ Các Thầy & anh chị chỉ chỗ sai. Em cảm ơn

Sub PhatSinh()    Dim sArray
    Dim i As Long
    Dim n1 As Range, n2 As Range, n3 As Range, n4 As Range, n5 As Range, n6 As Range, n7 As Range
    Dim B As String, M As String, Y As String, Z As String
    Dim m1
    
    
    With ActiveSheet
        Set n7 = .Range(.[B11], .[B65536].End(3))
        sArray = n7.Resize(, 6).Value
        m1 = .Range(.[A7]).Value
    End With
    
    With Sheets("Data")
        Set n1 = .Range(.[B10], .[B65536].End(3))
        Set n2 = n1.Offset(, 3)    ' cot E
        Set n3 = n1.Offset(, 5)    ' cot G
        Set n4 = n1.Offset(, 7)    ' cot I
        Set n5 = n1.Offset(, 8)    ' cot J
        Set n6 = n1.Offset(, 9)    ' cot K
    End With


    For i = 1 To UBound(sArray, 1)


        If Not IsNumeric(sArray(i, 1)) Then
            If Left(sArray(i, 1), 1) = "B" Then
                sArray(i, 5) = Evaluate("SUMPRODUCT((" & n2.Address & "=""" & m1 & """)*(" & _
                n3.Address & "=""" & sArray(i, 1) & """)*(" & _
                n4.Address & "=""&131&"")*(" & n6.Address & "))")
                
                sArray(i, 6) = Evaluate("SUMPRODUCT((" & n2.Address & "=""" & m1 & """)*(" & _
                n3.Address & "=""" & sArray(i, 1) & """)*(" & _
                n5.Address & "=""&131&"")*(" & n6.Address & "))")
            End If
        End If
        
        If IsNumeric(sArray(i, 1)) Then
            If sArray(i, 1) = 131 Then
                sArray(i, 5) = Evaluate("SUMPRODUCT((" & n2.Address & "=""" & m1 & """)*(" & _
                n4.Address & "=""&131&"")*(" & n6.Address & "))")
                
                sArray(i, 6) = Evaluate("SUMPRODUCT((" & n2.Address & "=""" & m1 & """)*(" & _
                n5.Address & "=""&131&"")*(" & n6.Address & "))")
            End If
        End If
    Next i
    n7.Resize(, 6).Value = sArray
End Sub

 

[Quang_Hải]

Em đã dùng Evaluate("SUMPRODUCT(...... )") rồi, code bây giờ kg báo lỗi, nhưng khi chạy code thì tất cả cho giá trị bằng 0
Em cũng đã thay thử các điều kiên, nhưng tìm mãi chưa ra, em bó tay nó rồi!
Em nhờ Các Thầy & anh chị chỉ chỗ sai. Em cảm ơn

Xem đám rừng của mình nhé. Code không đẹp nhưng chịu chạy.
Mới gom code lại bỏ bớt 1 FOR

Sub cong()
Dim dl(), SDL(), i, j, a, b, c, d, thang
thang = Sheet13.[A7]
Sheet13.[F11:G193].ClearContents
dl = Sheet13.Range(Sheet13.[B11], Sheet13.[B65536].End(3)).Resize(, 6).Value
SDL = Sheet15.Range(Sheet15.[E10], Sheet15.[E65536].End(3)).Resize(, 7).Value
For i = 1 To UBound(dl)
   If IsNumeric(dl(i, 1)) Then
      If dl(i, 1) = 131 Then a = i
      If dl(i, 1) = 331 Then b = i
      If dl(i, 1) = 1388 Then c = i
      If dl(i, 1) = 3388 Then d = i
   End If
   For j = 1 To UBound(SDL)
      If SDL(j, 1) = thang Then
         If SDL(j, 6) = 131 Then
            If i = a Then dl(a, 6) = dl(a, 6) + SDL(j, 7)
            If SDL(j, 3) = dl(i, 1) Then dl(i, 6) = dl(i, 6) + SDL(j, 7)
         ElseIf SDL(j, 5) = 131 Then
            If i = a Then dl(a, 5) = dl(a, 5) + SDL(j, 7)
            If SDL(j, 3) = dl(i, 1) Then dl(i, 5) = dl(i, 5) + SDL(j, 7)
         ElseIf SDL(j, 6) = 331 Then
            If i = b Then dl(b, 6) = dl(b, 6) + SDL(j, 7)
            If SDL(j, 3) = dl(i, 1) Then dl(i, 6) = dl(i, 6) + SDL(j, 7)
         ElseIf SDL(j, 5) = 331 Then
            If i = b Then dl(b, 5) = dl(b, 5) + SDL(j, 7)
            If SDL(j, 3) = dl(i, 1) Then dl(i, 5) = dl(i, 5) + SDL(j, 7)
         ElseIf SDL(j, 6) = 1388 Then
            If i = c Then dl(c, 6) = dl(c, 6) + SDL(j, 7)
            If SDL(j, 3) = dl(i, 1) Then dl(i, 6) = dl(i, 6) + SDL(j, 7)
         ElseIf SDL(j, 5) = 1388 Then
            If i = c Then dl(c, 5) = dl(c, 5) + SDL(j, 7)
            If SDL(j, 3) = dl(i, 1) Then dl(i, 5) = dl(i, 5) + SDL(j, 7)
         ElseIf SDL(j, 6) = 3388 Then
            If i = d Then dl(d, 6) = dl(d, 6) + SDL(j, 7)
            If SDL(j, 3) = dl(i, 1) Then dl(i, 6) = dl(i, 6) + SDL(j, 7)
         ElseIf SDL(j, 5) = 3388 Then
            If i = d Then dl(d, 5) = dl(d, 5) + SDL(j, 7)
            If SDL(j, 3) = dl(i, 1) Then dl(i, 5) = dl(i, 5) + SDL(j, 7)
         End If
      End If
   Next
Next
Sheet13.[B11].Resize(i - 1, 6) = dl
End Sub

 

[Hong.Van]

Bước sang năm mới, em kính chúc các Thầy cô & anh chị một năm mới AN KHANG - THỊNH VƯỢNG
----------------
Rất mong Thầy cô xem & phân tích giúp em code ở bài #3 sai chỗ nào? để em học hỏi
---------------------
Em cảm ơn anh QuangHai, Bây giờ em muốn tổng hợp cả năm, nghĩa là bỏ điều kiện tại thang = Sheet13.[A7] thi code trên sửa như thế nào? code của anh, em chưa hiểu lắm! nhờ anh giúp thêm 1 lần!
Anh xem File!
------------------
Xin cảm ơn

 

[Quang_Hải]

Bước sang năm mới, em kính chúc các Thầy cô & anh chị một năm mới AN KHANG - THỊNH VƯỢNG
----------------
Rất mong Thầy cô xem & phân tích giúp em code ở bài #3 sai chỗ nào? để em học hỏi
---------------------
Em cảm ơn anh QuangHai, Bây giờ em muốn tổng hợp cả năm, nghĩa là bỏ điều kiện tại thang = Sheet13.[A7] thi code trên sửa như thế nào? code của anh, em chưa hiểu lắm! nhờ anh giúp thêm 1 lần!
Anh xem File!
------------------
Xin cảm ơn

HongVan xóa dòng điều kiện If SDL= thang và cái End If của nó là được rồi

 

[Hong.Van]

HongVan xóa dòng điều kiện If SDL= thang và cái End If của nó là được rồi

Cảm ơn anh !
----------
Bài của anh có fân biệt Mã khách hàng là chữ hoa chữ thường, ai sử dụng thì fải lưu ý!