Thay hàm sumproduct trong VBA bằng array ?

[win-sun]

- Nhờ các sư phụ hướng dẫn giúp em bài này, em cần hướng dẫn code để thay thế hàm sumproduct trong trường hợp này có được không? xin cảm ơn!

 

[sealand]

Bạn xem 1 ví dụ nha:

Vùng A1:A31: ĐKiện 1
Vùng B1:B31: Điều kiện 2.
Vùng C1:C31: Vùng dữ liệu cần cộng.

Sub Sumproduct_Arr()
Dim Tm1(), Tm2(), Tm3(), i
ReDim Tm1(31), Tm2(31), Tm3(31)
For i = 1 To 31
Tm1(i - 1) = (Sheet1.Cells(i, 1).Value = "A02") * 1
Tm2(i - 1) = (Sheet1.Cells(i, 2).Value = "B02") * 1
Tm3(i - 1) = Sheet1.Cells(i, 3)
Next
MsgBox WorksheetFunction.SumProduct(Tm1, Tm2, Tm3)
End Sub

 

[sealand]

Một cách hiểu khác

Sub thu2()
Dim Tm, i, Kq
Tm = Sheet1.[A1:C31]
For i = 1 To UBound(Tm, 1)
Kq = Kq + (Tm(i, 1) = "A02") * (Tm(i, 2) = "B02") * Tm(i, 3)
Next
MsgBox Kq
End Sub

 

[win-sun]

Em up lại File Bác Sealand xem giúp em cái nhé! vấn đề là làm sao để tính được sohh nào đã hoàn tất, cái nào chưa cắt dán và cái nào đã xuất đi... cảm ơn Bác.

 

[sealand]

Bạn định làm cái gì thế này, thật khó mà hiểu và làm được theo ý bạn với cấu trúc như thế này. Bạn nên điều chỉnh lại đi.Nên có các sheet (Bảng) như sau:

1/Danh Mục: Kê khai các danh mục. (bạn đã có)
2/Bảng kê các đơn hàng: So, ngay, khách,loại, luong
3/Bảng thống kê thực hiện: So,ngay, mahh, phoi, nhapkho, dagiao (Nếu cần chi tiết tùng đơn hàng thì phải có cột số dơn hàng)

Từ dữ liệu như vậy bạn mới thống kê chính xác được. Làm như bạn và theo dõi SX e không ổn, có bữa không chính xác xếp la thấu trời.
Còn cái việc bạn đề nghị, bạn phải nói để mình hiểu ý bạn chứ hay dở đều giải quyết được. Mình không hiểu là đưa cái gì vào Array và đưa như thế nào, để làm gì?

 

[win-sun]

Dử liệu em đã nạp vào sh Data rồi, trong đó có đầy đủ thông tin. Giờ em muốn lọc những đơn hàng ra và kiểm tra xem tình trạng của nó như thế nào. đặt điểm là mỗi lần đặt hàng thì em gáng số cho nó để theo dõi, mỗi số đặt hàng có thể thực hiện (cắt dán) trong nhiều lần hoặc xuất kho nhiều lần (đặt số lượng lớn)
Thật ra nếu gáng công thức thì vẫn tính được bằng sumproduct, nhưng dự kiến dử liệu sẽ rất lớn nên em k yên tâm thôi, em thấy sử dụng array tính toán rồi đưa vào cột J, K, L ở Sh KTRA có được k Bác?

 

[sealand]

Bạn thay đoạn code này vào sẽ tính được cả từ ngày đến ngày luôn

Sub LOC_KTRA()
Dim endr As Long
endr = ActiveSheet.[A65000].End(xlUp).Row
'Range([A9], [A9].End(xlDown).Offset(1)).Resize(, 12).ClearContents
        Range("DATA").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets( _
        "KTRA").Range("tieude"), CopyToRange:=Range("A8:I8"), Unique:=True
'---------------------------------------------------------------------------------
Dim Tm, Kq(), tu, den, i, j
Dim Rg As Range
 Set Rg = Sheet2.Range([C9], [C65536].End(3))
 tu = Sheet2.[E2]: den = Sheet2.[F2]
 Tm = S104.Range(S104.[A2], S104.[A65536].End(3)).Resize(, 9)
 ReDim Kq(1 To Rg.Count)
   For i = 1 To Rg.Count
   For j = 1 To UBound(Tm, 1)
   If Tm(j, 1) >= tu And Tm(j, 1) <= den And Tm(j, 3) = Rg.Item(i) Then
   Kq(i) = Kq(i) + Tm(j, 9)
   End If
   Next j
   Next i
   Sheet2.[j9].Resize(Rg.Count) = WorksheetFunction.Transpose(Kq)
   
    End Sub

Mình không biết tính cột K,L thế nào chứ đã tính thì tính 1 thể luôn

 

[win-sun]

Chưa có tác dụng gì Bác ơi, thật ra chỉ cần làm sao tính nhanh dược 3 cột cuối ở sh data là được, nếu để công thức thế này thì k chạy nối?

 

[concogia]

Chưa có tác dụng gì Bác ơi, thật ra chỉ cần làm sao tính nhanh dược 3 cột cuối ở sh data là được, nếu để công thức thế này thì k chạy nối?

Thú thật là nhìn cái bảng mình chẳng hiểu mô tê gì cả.
Hình như bạn muốn dùng code để bỏ mấy em Sumproduct ???
Thôi, làm tạm thế này, bạn thêm nhiều dữ liệu xem tốc độ có ổn hơn dùng công thức không nhé, có gì tính sau

Public Sub ThaySumProduct()
    Dim Vung, J, I, Mg()
    Vung = Range([b2], [b10000].End(xlUp)).Resize(, 8).Value
    ReDim Mg(1 To UBound(Vung), 1 To 3)
        For I = 1 To UBound(Vung)
            If Vung(I, 1) = "Phi" & ChrW(7871) & "u " & ChrW(273) & ChrW(7863) & "t hàng" Then
                For J = 1 To UBound(Vung)
                    If Vung(J, 1) = "Nh" & ChrW(7853) & "p c" & ChrW(7855) & "t dán" And Vung(J, 2) = Vung(I, 2) Then
                        Mg(I, 1) = Mg(I, 1) + Vung(J, 8)
                    ElseIf Vung(J, 1) = "Xu" & ChrW(7845) & "t kho" And Vung(J, 2) = Vung(I, 2) Then
                        Mg(I, 2) = Mg(I, 2) + Vung(J, 8)
                    End If
                Next J
                    If Vung(I, 8) = Mg(I, 1) And Vung(I, 8) = Mg(I, 2) Then
                        Mg(I, 3) = ChrW(272) & "ã giao"
                    ElseIf Mg(I, 1) * Mg(I, 2) = 0 Then
                        Mg(I, 3) = "Ch" & ChrW(432) & "a làm"
                    ElseIf Vung(I, 8) = Mg(I, 1) And Mg(I, 2) = "" Then
                        Mg(I, 3) = "Chua giao"
                    Else
                        Mg(I, 3) = "Xem lai"
                    End If
            End If
        Next I
    [U2:W10000].ClearContents
    [U2].Resize(UBound(Vung), 3) = Mg
End Sub

Bạn bấm Ctrl + Shift + R để chạy code
Kết quả mình gán vào cột U, V, W để tiện kiểm tra với công thức
Thân