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

Blue Softs Liên hệ QC

kai-lee

Thành viên mới
Tham gia
4/8/20
Bài viết
1
Được thích
0
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:

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
 

File đính kèm

  • Report-1-8-2021_Rgon.xlsx
    5.6 MB · Đọc: 10

Cá ngừ F1

( ͡° ͜ʖ ͡°)
Thành viên BQT
Moderator
Tham gia
1/1/08
Bài viết
2,492
Được thích
3,606
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
Quan hệ.. và quan hệ..
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.
 
Upvote 0

Cá ngừ F1

( ͡° ͜ʖ ͡°)
Thành viên BQT
Moderator
Tham gia
1/1/08
Bài viết
2,492
Được thích
3,606
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
Quan hệ.. và quan hệ..
Bạn thử code này nhé
Mã:
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
 

File đính kèm

  • Report-1-8-2021_Rgon.xlsm
    5.5 MB · Đọc: 9
Upvote 0
Top Bottom