Thay thế hàm Sumifs trên Excel bằng VBA

[kai-lee]

Dear Chuyên Gia
em có làm báo cáo quyết toán
phần sheet report trong xuất khẩu
có viết công thức dưới dạng excel
mà file nặng quá . em muốn tối giản lên VBA
nhờ Chuyên gia giúp em với
Thanks

Bài đã được tự động gộp: 17/9/21

Dear Chuyên Gia
em có làm báo cáo quyết toán
phần sheet report trong xuất khẩu
có viết công thức dưới dạng excel
mà file nặng quá . em muốn tối giản lên VBA
nhờ Chuyên gia giúp em với
Thanks

Dear chuyen Gia
e Gửi file nhờ chuyên gia giúp em với

 

[befaint]

Nội quy diễn đàn

You must agree to these terms and rules before using the site.

www.giaiphapexcel.com

 

[Cá ngừ F1]

Bạn chỉnh sửa một số nội dung để đúng nội quy nhé:
1. Tiêu đề cần có dấu và sát với câu hỏi
2. Nội dung bài viết đừng nửa Tây nửa Ta.
3. Đưa bài vào Box Lập trình với Excel. (cái này tôi sẽ di chuyển cho bạn)
4. Nếu File nặng quá bạn chỉ cần lấy vài chục bản ghi để ví dụ thôi
Thân.

 

[Cá ngừ F1]

Bạn thử code này nhé

Sub GPE()
On Error Resume Next
Dim sArr(), i&, j&, k&, dArr(), Dic As Object, Col, Itm, Data(), KQ()
sArr = Range(Sheet2.[D3], Sheet2.[AB1000000].End(3))
ReDim dArr(1 To UBound(sArr), 1 To 8)
Col = Array(0, 18, 19, 20, 21, 22, 23, 24, 25)
Data = Range(Sheet1.[B3], Sheet1.[F1000000].End(3))
ReDim KQ(1 To UBound(Data), 1 To 8)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(sArr)
    Itm = CStr(sArr(i, 1) & sArr(i, 8))
    If Not Dic.exists(Itm) Then
        k = k + 1
        Dic(Itm) = k
        For j = 1 To 8
            dArr(k, j) = sArr(i, Col(j))
        Next
    Else
        For j = 1 To 8
            dArr(Dic.Item(Itm), j) = dArr(Dic.Item(Itm), j) + sArr(i, Col(j))
        Next
    End If
Next
For i = 1 To UBound(Data)
    Itm = CStr(Data(i, 1) & Data(i, 5))
    For j = 1 To 8
        KQ(i, j) = dArr(Dic.Item(Itm), j)
    Next
Next
Sheet1.[O3].Resize(i - 1, 8) = KQ
End Sub