Nhờ thay thế hàm SUMPRODUCT trong file để Excel tính toán nhanh hơn (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
MinhKhai

MinhKhai

Giải pháp Ếc-xào
Tham gia
16/4/08
Bài viết
941
Được thích
573
Bên cạnh hàm Vlookup thì em hay dùng hàm SUMPRODUCT vì nó rất dễ dùng để tính toán theo nhiều điều kiện.
Nhưng thật không may là đối với dữ liệu lớn, hàm SUMPRODUCT khiến file Excel chạy ì ạch 1 cách rõ rệt, cụ thể như trong file có link dưới đây.
Nhờ các anh chị gợi ý cách dùng hàm khác hoặc chuyển đổi giúp sang dùng VBA để tăng tốc độ tính toán mỗi khi có sự thay đổi trong sheet. (Em vẫn cần bật tính năng Auto Calculation của Excel)

Xin cảm ơn !

www.dropbox.com

Transfer - Dropbox

Dropbox is a free service that lets you bring your photos, docs, and videos anywhere and share them easily. Never email yourself a file again!
www.dropbox.com www.dropbox.com
 
MinhKhai đã viết:
Bên cạnh hàm Vlookup thì em hay dùng hàm SUMPRODUCT vì nó rất dễ dùng để tính toán theo nhiều điều kiện.
Nhưng thật không may là đối với dữ liệu lớn, hàm SUMPRODUCT khiến file Excel chạy ì ạch 1 cách rõ rệt, cụ thể như trong file có link dưới đây.
Nhờ các anh chị gợi ý cách dùng hàm khác hoặc chuyển đổi giúp sang dùng VBA để tăng tốc độ tính toán mỗi khi có sự thay đổi trong sheet. (Em vẫn cần bật tính năng Auto Calculation của Excel)

Xin cảm ơn !

www.dropbox.com

Transfer - Dropbox

Dropbox is a free service that lets you bring your photos, docs, and videos anywhere and share them easily. Never email yourself a file again!
www.dropbox.com www.dropbox.com
Nhấp chuột vào đây để mở rộng...
Dùng code này cho sheet.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    With Sheet1
        If Not Intersect(Target, .Range("D3", "F3")) Is Nothing Then
            If (.Range("D3").Value = Empty) Or (.Range("F3").Value = Empty) Then Exit Sub
            Dim sArr, Arr1(1 To 28, 1 To 14), Arr2(1 To 28, 1 To 33), i As Long, j As Long, k As Long, Tmp As String, iCol As Byte, nam%, Thang As Byte
            sArr = Sheet2.Range("B3:E" & Sheet2.Range("E1000000").End(xlUp).Row).Value
            iCol = IIf(.Range("D3").Value = "Kg", 3, 2)
            nam = .Range("F3").Value: Thang = Val(Right(.Range("D38"), 2))
            k = 0
            With CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(sArr)
                    Tmp = sArr(i, 1)
                    j = Month(sArr(i, 4)) + 2
                    If Year(sArr(i, 4)) = nam Then
                        If Not .Exists(Tmp) Then
                            k = k + 1
                            .Add Tmp, k
                            
                            Arr1(k, 1) = Tmp: Arr1(k, 2) = sArr(i, iCol)
                            Arr1(k, j) = sArr(i, iCol)
                            
                            If Thang = Month(sArr(i, 4)) Then
                                Arr2(k, 1) = Tmp: Arr2(k, 2) = sArr(i, iCol)
                                Arr2(k, Day(sArr(i, 4)) + 2) = sArr(i, iCol)
                            End If
                        Else
                            Arr1(.Item(Tmp), 2) = Arr1(.Item(Tmp), 2) + sArr(i, iCol)
                            Arr1(.Item(Tmp), j) = Arr1(.Item(Tmp), j) + sArr(i, iCol)
                            
                            If Thang = Month(sArr(i, 4)) Then
                                j = Day(sArr(i, 4)) + 2
                                Arr2(.Item(Tmp), 2) = Arr2(.Item(Tmp), 2) + sArr(i, iCol)
                                Arr2(.Item(Tmp), j) = Arr2(.Item(Tmp), j) + sArr(i, iCol)
                            End If
                        End If
                    End If
                Next i
            End With
            .Range("C6:P33").ClearContents
            .Range("C40:AI67").ClearContents
            If k Then
                .Range("C6").Resize(k, 14) = Arr1
                .Range("C40").Resize(k, 33) = Arr2
            End If
        End If
    End With
End Sub
 
Bluestar092011 đã viết:
Dùng code này cho sheet.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    With Sheet1
        If Not Intersect(Target, .Range("D3", "F3")) Is Nothing Then
            If (.Range("D3").Value = Empty) Or (.Range("F3").Value = Empty) Then Exit Sub
            Dim sArr, Arr1(1 To 28, 1 To 14), Arr2(1 To 28, 1 To 33), i As Long, j As Long, k As Long, Tmp As String, iCol As Byte, nam%, Thang As Byte
            sArr = Sheet2.Range("B3:E" & Sheet2.Range("E1000000").End(xlUp).Row).Value
            iCol = IIf(.Range("D3").Value = "Kg", 3, 2)
            nam = .Range("F3").Value: Thang = Val(Right(.Range("D38"), 2))
            k = 0
            With CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(sArr)
                    Tmp = sArr(i, 1)
                    j = Month(sArr(i, 4)) + 2
                    If Year(sArr(i, 4)) = nam Then
                        If Not .Exists(Tmp) Then
                            k = k + 1
                            .Add Tmp, k
                           
                            Arr1(k, 1) = Tmp: Arr1(k, 2) = sArr(i, iCol)
                            Arr1(k, j) = sArr(i, iCol)
                           
                            If Thang = Month(sArr(i, 4)) Then
                                Arr2(k, 1) = Tmp: Arr2(k, 2) = sArr(i, iCol)
                                Arr2(k, Day(sArr(i, 4)) + 2) = sArr(i, iCol)
                            End If
                        Else
                            Arr1(.Item(Tmp), 2) = Arr1(.Item(Tmp), 2) + sArr(i, iCol)
                            Arr1(.Item(Tmp), j) = Arr1(.Item(Tmp), j) + sArr(i, iCol)
                           
                            If Thang = Month(sArr(i, 4)) Then
                                j = Day(sArr(i, 4)) + 2
                                Arr2(.Item(Tmp), 2) = Arr2(.Item(Tmp), 2) + sArr(i, iCol)
                                Arr2(.Item(Tmp), j) = Arr2(.Item(Tmp), j) + sArr(i, iCol)
                            End If
                        End If
                    End If
                Next i
            End With
            .Range("C6:P33").ClearContents
            .Range("C40:AI67").ClearContents
            If k Then
                .Range("C6").Resize(k, 14) = Arr1
                .Range("C40").Resize(k, 33) = Arr2
            End If
        End If
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Đúng là dùng Code, file chạy phe phé. Cảm ơn bác rất nhiều
Khi chạy code cái ô C40:C67 bị xóa trắng, em chưa rõ nguyên nhân, bác chỉ giúp với

1586879292322.png
 
MinhKhai đã viết:
Đúng là dùng Code, file chạy phe phé. Cảm ơn bác rất nhiều
Khi chạy code cái ô C40:C67 bị xóa trắng, em chưa rõ nguyên nhân, bác chỉ giúp với

View attachment 235589
Nhấp chuột vào đây để mở rộng...
Sửa code của #2 nhé! Bỏ lệnh này ra ngoài lệnh IF.
Mã: 
Arr2(k, 1) = Tmp
Cụ thể sửa.
Mã: 
                       If Not .Exists(Tmp) Then
                            k = k + 1
                            .Add Tmp, k
                          
                            Arr1(k, 1) = Tmp: Arr1(k, 2) = sArr(i, iCol)
                            Arr1(k, j) = sArr(i, iCol)
                          
                            If Thang = Month(sArr(i, 4)) Then
                                Arr2(k, 1) = Tmp: Arr2(k, 2) = sArr(i, iCol)
                                Arr2(k, Day(sArr(i, 4)) + 2) = sArr(i, iCol)
                            End If
                        Else
                            Arr1(.Item(Tmp), 2) = Arr1(.Item(Tmp), 2) + sArr(i, iCol)
                            Arr1(.Item(Tmp), j) = Arr1(.Item(Tmp), j) + sArr(i, iCol)
                          
                            If Thang = Month(sArr(i, 4)) Then
                                j = Day(sArr(i, 4)) + 2
                                Arr2(.Item(Tmp), 2) = Arr2(.Item(Tmp), 2) + sArr(i, iCol)
                                Arr2(.Item(Tmp), j) = Arr2(.Item(Tmp), j) + sArr(i, iCol)
                            End If
                        End If
Thành
Mã: 
                       If Not .Exists(Tmp) Then
                            k = k + 1
                            .Add Tmp, k
                          
                            Arr1(k, 1) = Tmp: Arr1(k, 2) = sArr(i, iCol)
                            Arr1(k, j) = sArr(i, iCol)
                            Arr2(k, 1) = Tmp
                            If Thang = Month(sArr(i, 4)) Then
                                Arr2(k, 2) = sArr(i, iCol)
                                Arr2(k, Day(sArr(i, 4)) + 2) = sArr(i, iCol)
                            End If
                        Else
                            Arr1(.Item(Tmp), 2) = Arr1(.Item(Tmp), 2) + sArr(i, iCol)
                            Arr1(.Item(Tmp), j) = Arr1(.Item(Tmp), j) + sArr(i, iCol)
                          
                            If Thang = Month(sArr(i, 4)) Then
                                j = Day(sArr(i, 4)) + 2
                                Arr2(.Item(Tmp), 2) = Arr2(.Item(Tmp), 2) + sArr(i, iCol)
                                Arr2(.Item(Tmp), j) = Arr2(.Item(Tmp), j) + sArr(i, iCol)
                            End If
                        End If
Ngoài ra code trên còn bổ sung thêm điều kiện ô D38, cụ thể sửa code ở #2 như sau:
Thay đoạn code.
Mã: 
 If Not Intersect(Target, .Range("D3", "F3")) Is Nothing Then
            If (.Range("D3").Value = Empty) Or (.Range("F3").Value = Empty) Then Exit Sub
thành
Mã: 
If Not Intersect(Target, .Range("D3,F3,D38")) Is Nothing Then
            If (.Range("D3").Value = Empty) Or (.Range("F3").Value = Empty) Or (.Range("D38").Value = Empty) Then Exit Sub
 
Lần chỉnh sửa cuối:
giaiphap đã viết:
Sửa code của #2 nhé! Bỏ lệnh này ra ngoài lệnh IF.
Mã: 
Arr2(k, 1) = Tmp
Cụ thể sửa.
Mã: 
                       If Not .Exists(Tmp) Then
                            k = k + 1
                            .Add Tmp, k
                         
                            Arr1(k, 1) = Tmp: Arr1(k, 2) = sArr(i, iCol)
                            Arr1(k, j) = sArr(i, iCol)
                         
                            If Thang = Month(sArr(i, 4)) Then
                                Arr2(k, 1) = Tmp: Arr2(k, 2) = sArr(i, iCol)
                                Arr2(k, Day(sArr(i, 4)) + 2) = sArr(i, iCol)
                            End If
                        Else
                            Arr1(.Item(Tmp), 2) = Arr1(.Item(Tmp), 2) + sArr(i, iCol)
                            Arr1(.Item(Tmp), j) = Arr1(.Item(Tmp), j) + sArr(i, iCol)
                         
                            If Thang = Month(sArr(i, 4)) Then
                                j = Day(sArr(i, 4)) + 2
                                Arr2(.Item(Tmp), 2) = Arr2(.Item(Tmp), 2) + sArr(i, iCol)
                                Arr2(.Item(Tmp), j) = Arr2(.Item(Tmp), j) + sArr(i, iCol)
                            End If
                        End If
Thành
Mã: 
                       If Not .Exists(Tmp) Then
                            k = k + 1
                            .Add Tmp, k
                         
                            Arr1(k, 1) = Tmp: Arr1(k, 2) = sArr(i, iCol)
                            Arr1(k, j) = sArr(i, iCol)
                            Arr2(k, 1) = Tmp
                            If Thang = Month(sArr(i, 4)) Then
                                Arr2(k, 2) = sArr(i, iCol)
                                Arr2(k, Day(sArr(i, 4)) + 2) = sArr(i, iCol)
                            End If
                        Else
                            Arr1(.Item(Tmp), 2) = Arr1(.Item(Tmp), 2) + sArr(i, iCol)
                            Arr1(.Item(Tmp), j) = Arr1(.Item(Tmp), j) + sArr(i, iCol)
                         
                            If Thang = Month(sArr(i, 4)) Then
                                j = Day(sArr(i, 4)) + 2
                                Arr2(.Item(Tmp), 2) = Arr2(.Item(Tmp), 2) + sArr(i, iCol)
                                Arr2(.Item(Tmp), j) = Arr2(.Item(Tmp), j) + sArr(i, iCol)
                            End If
                        End If
Ngoài ra code trên còn bổ sung thêm điều kiện ô D38, cụ thể sửa code ở #2 như sau:
Thay đoạn code.
Mã: 
If Not Intersect(Target, .Range("D3", "F3")) Is Nothing Then
            If (.Range("D3").Value = Empty) Or (.Range("F3").Value = Empty) Then Exit Sub
thành
Mã: 
If Not Intersect(Target, .Range("D3,F3,D38")) Is Nothing Then
            If (.Range("D3").Value = Empty) Or (.Range("F3").Value = Empty) Or (.Range("D38").Value = Empty) Then Exit Sub
Nhấp chuột vào đây để mở rộng...
Bác chỉ dẫn rất chi tiết và hiệu quả, đặc biệt phần thêm điều kiện ở ô D38.
Bây giờ chỉ là việc em tìm hiểu để khi thêm điều kiện tính toán thì sửa code như thế nào thôi.
Cảm ơn 2 bác, chúc 2 bác mạnh khỏe !
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

L
xin anh chị giúp em công thức tính tổng năm theo điều kiện ạ
Trả lời
9
Đọc
197
HieuCD
H
Y
Lấy dữ liệu từ nhiều sheet khác nhau.
2
Trả lời
20
Đọc
574
lib.enigma
L
GPE-Trợ Lý
ĐĂNG KÍ THAM DỰ SINH NHẬT GPE TẠI HN - SỰ KIỆN TALKSHOW ĐẶC BIỆT (1 người xem)
    • Thích
2
Trả lời
25
Đọc
1K
hoangdanh282vn
hoangdanh282vn
Nguyễn Duy Tuân
  • Dán lên cao
Sử dụng AI trong Excel với Add-in A-Tools AI v10
    • Thích
    • Cảm ơn
Trả lời
8
Đọc
873
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
In lặp lại nhiều dòng ở cuối các trang
Trả lời
13
Đọc
412
Hoàng Tuấn 868
H
T
Cách cộng tổng chính xác nhất
Trả lời
6
Đọc
200
minhminh27
minhminh27
K
Tạo mã thiết bị
Trả lời
10
Đọc
264
khoailang
K
C
Xin file lên thực đơn và định lượng món ăn cho suất ăn công nghiệp
Trả lời
0
Đọc
70
Chihuong_vp90
C
T
Lỗi Khi Mở File Excel
Trả lời
3
Đọc
107
Hoàng Tuấn 868
H
H
Em chào anh chị ạ.Em cần xếp lịch nghỉ randum cho 1 số nhóm làm việc trong 1 công ty.
Trả lời
4
Đọc
151
Duy Tùng 9x
Duy Tùng 9x
1
Em hỏi chút về hàm điều kiện với liệt kê
Trả lời
2
Đọc
141
123456it
1
M
File excel ứng dụng trong nhập xuất kho, thu chi, bán hàng và công nợ (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
7 8 9
Trả lời
165
Đọc
31K
quick87
quick87
chickenexcel
xin hướng dẫn code chọn hình ảnh trong file
Trả lời
2
Đọc
114
chickenexcel
chickenexcel
tramcannt
data validation
Trả lời
2
Đọc
126
ptm0412
ptm0412
giaiphap
Add-Ins cho Excel 2007 -2016 32bit và 64bit
    • Thích
    • Yêu thích
    • Ngạc nhiên
24 25 26
Trả lời
514
Đọc
204K
hoangtuan.net
hoangtuan.net
Nguyễn Duy Tuân
  • Dán lên cao
Phiên bản mới Add-in A-Tools AI v10 (2024)
    • Thích
2 3
Trả lời
56
Đọc
7K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
Lỗi syntax error
Trả lời
2
Đọc
125
ptm0412
ptm0412
H
Xin các bác giúp đỡ cách đổi thời gian thành số thập phân
Trả lời
8
Đọc
168
huyphanthieu
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
17 18 19
Trả lời
361
Đọc
40K
NGUYEN THOA 123
NGUYEN THOA 123
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
tungnguyen_kt
tungnguyen_kt
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Sinh nhật lần 19 GPE

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom