Code thay thế hàm sumif để giảm dung lượng file

Liên hệ QC
T

tanthanh94

Thành viên mới
Tham gia
24/8/14
Bài viết
46
Được thích
3
Hiện tại file sử dụng hàm sumif rất nhiều dòng
Nay nhờ các Anh viết code để giảm dung lượng file
 

File đính kèm

  • CODE SUMIF.xls
    23.5 KB · Đọc: 416
Sắp xếp theo thời gian sắp xếp theo bầu chọn
tanthanh94 đã viết:
Hiện tại file sử dụng hàm sumif rất nhiều dòng
Nay nhờ các Anh viết code để giảm dung lượng file
Nhấp chuột vào đây để mở rộng...

SUMIF với 5000 dòng chưa phải là "oải".
Muốn Sub thì tặng bạn cái này.
PHP: 
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([B5], [B5].End(xlDown)).Resize(, 5).Value2
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    If Not Dic.Exists(Tem) Then
        Dic.Add Tem, sArr(I, 5)
    Else
        Dic.Item(Tem) = Dic.Item(Tem) + sArr(I, 5)
    End If
Next I
For I = 1 To UBound(sArr, 1)
    dArr(I, 1) = Dic.Item(sArr(I, 1))
Next I
[H5].Resize(I - 1) = dArr
Set Dic = Nothing
End Sub
 
Upvote 0
Ba Tê đã viết:
SUMIF với 5000 dòng chưa phải là "oải".
Muốn Sub thì tặng bạn cái này.
PHP: 
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([B5], [B5].End(xlDown)).Resize(, 5).Value2
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    If Not Dic.Exists(Tem) Then
        Dic.Add Tem, sArr(I, 5)
    Else
        Dic.Item(Tem) = Dic.Item(Tem) + sArr(I, 5)
    End If
Next I
For I = 1 To UBound(sArr, 1)
    dArr(I, 1) = Dic.Item(sArr(I, 1))
Next I
[H5].Resize(I - 1) = dArr
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Do file của em có 13 sheet dùng công thức như vậy nên cần code để giảm dung lượng file
Cám ơn anh rất nhiều
 
Upvote 0
Ba Tê đã viết:
SUMIF với 5000 dòng chưa phải là "oải".
Muốn Sub thì tặng bạn cái này.
PHP: 
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([B5], [B5].End(xlDown)).Resize(, 5).Value2
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    If Not Dic.Exists(Tem) Then
        Dic.Add Tem, sArr(I, 5)
    Else
        Dic.Item(Tem) = Dic.Item(Tem) + sArr(I, 5)
    End If
Next I
For I = 1 To UBound(sArr, 1)
    dArr(I, 1) = Dic.Item(sArr(I, 1))
Next I
[H5].Resize(I - 1) = dArr
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

Xin hỏi em dùng
PHP: 
Application.WorksheetFunction.SumIf
trong VBA có cải thiện tốt hơn khi dùng công thức ngoài sheets không
 
Upvote 0
phuyen89 đã viết:
Xin hỏi em dùng
PHP: 
Application.WorksheetFunction.SumIf
trong VBA có cải thiện tốt hơn khi dùng công thức ngoài sheets không
Nhấp chuột vào đây để mở rộng...
Cải thiện hơn đó bạn, khi đó ngoài sheet chỉ là các số CHẾT, ko phải là công thức nên Excel ko tính toán khi có sự thay đổi nữa.
 
Upvote 0
phuyen89 đã viết:
Xin hỏi em dùng
PHP: 
Application.WorksheetFunction.SumIf
trong VBA có cải thiện tốt hơn khi dùng công thức ngoài sheets không
Nhấp chuột vào đây để mở rộng...
Sau khi chạy code xong, việc cải thiện nó nằm ở chỗ: Trên bảng tính không còn công thức nữa ---> Không còn gì để tính toán nữa ---> Dẫn đến bảng tính sẽ nhanh
Tuy nhiên, do có dùng SUMIF trong code nên chắc chắn rằng tốc độ chạy code sẽ không bằng với việc xử lý mảng (dùng Dictionary chẳng hạn)
Nếu là tôi làm mà "ép" phải dùng SUMIF, tôi thà gõ công thức trên bảng tính rồi kéo fill xuống. Cuối cùng tôi copy paste values toàn bộ, chỉ chừa lại công thức ở dòng cuối cùng (để mai này muốn fill nữa thì fill) ---> Vậy là xong ---> Thử cách làm "nông dân không dùng code" này xem có "cải thiện" được gì đó không?
 
Upvote 0
Ba Tê đã viết:
SUMIF với 5000 dòng chưa phải là "oải".
Muốn Sub thì tặng bạn cái này.
PHP: 
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([B5], [B5].End(xlDown)).Resize(, 5).Value2
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    If Not Dic.Exists(Tem) Then
        Dic.Add Tem, sArr(I, 5)
    Else
        Dic.Item(Tem) = Dic.Item(Tem) + sArr(I, 5)
    End If
Next I
For I = 1 To UBound(sArr, 1)
    dArr(I, 1) = Dic.Item(sArr(I, 1))
Next I
[H5].Resize(I - 1) = dArr
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

Hay quá, để em áp dụng thử xem được không. Nhưng em vẫn chưa hình dung được điều kiện giống như hàm Sumif nhỉ?
 
Upvote 0
Anh Ba Tê ơi, sao tôi chạy thử code của anh và thay dữ liệu A, B C... thành ngày /tháng/ năm thì nó chỉ ra giá trị 0 nhỉ. Bài toán của tôi là cộng tự động các giá trị nếu cùng ngày. Ví dụ ngày 20/11/2017 cùng phát sinh 200 và dòng khác 20/11/2017 phát sinh giá trị 300 thì giá trị tổng cộng phải là 500. Tôi thử khai báo sArr và dArr là kiểu date nhưng không được. Chân thành cảm ơn anh.
 
Upvote 0
minhchung_jazz đã viết:
Anh Ba Tê ơi, sao tôi chạy thử code của anh và thay dữ liệu A, B C... thành ngày /tháng/ năm thì nó chỉ ra giá trị 0 nhỉ. Bài toán của tôi là cộng tự động các giá trị nếu cùng ngày. Ví dụ ngày 20/11/2017 cùng phát sinh 200 và dòng khác 20/11/2017 phát sinh giá trị 300 thì giá trị tổng cộng phải là 500. Tôi thử khai báo sArr và dArr là kiểu date nhưng không được. Chân thành cảm ơn anh.
Nhấp chuột vào đây để mở rộng...
Bên trên khai báo "Tem as String"
Bạn chỉ cần thay bằng "Tem as Variant" hoặc bỏ "as String" là được.
 
Upvote 0
Ba Tê đã viết:
Bên trên khai báo "Tem as String"
Bạn chỉ cần thay bằng "Tem as Variant" hoặc bỏ "as String" là được.
Nhấp chuột vào đây để mở rộng...

Cảm ơn a Ba Tê rất nhiều ạ, tuy nhiên tôi lại gặp phải 1 trường hợp oái ăm và có thêm 3 câu hỏi, mong anh chỉ giáo cho người mới tìm hiểu VBA như tôi:
1. Khi bỏ "as string" hoặc khai báo thành Variant như anh thì gặp lỗi: "khi tôi xóa hết dữ liệu ở cột B thì chạy code nó tự cộng tổng thành giá trị 2380 tất cả các dòng từ H5 đến dòng cuối cùng của cột H".
2. Nếu bây giờ bài toán của tôi phát sinh thêm việc: tôi muốn VBA tự động lookup những số liệu có ngày tháng mà sau khi tính tổng như sumif ở cột H thì đưa lên tương ứng ngày tháng có đã ghi sẵn hàng ngang ở hàng 2 (Điền vào hàng 3 hoặc hàng tương ứng bất kỳ dưới hàng 2 có mã tên giống mã tên cột H)thì sẽ viết code như thế nào anh nhỉ?
3: Nếu tại ô B2 tôi điền tay là 1 ngày bất kỳ thì từ ô C2 đến ô CZX2 tự động điền các ngày tiếp theo liên tiếp với ngày đã điền, sau đó lookup giá trị đã được sumif ở cột H tương ứng với ngày trên hàng 3 (tính từ ô B3). Mục hỏi 2 và 3 tôi đã làm đc công tác này bằng công thức hàm nhưng file có 30 sheet dữ liệu thì rất nặng nên muốn dùng VBA cho nhẹ hơn.
4: Nếu tôi thay ngược lại cột F (từ F5) là ngày tháng, cột B (Từ B5) là khối lượng thì phải viết code đổi lại thế nào để vẫn tính được?
Trân trọng cảm ơn phản hồi của a Ba Tê và các anh chị khác góp ý. (Vui lòng xem file đính kèm)
 

File đính kèm

  • 1.xls
    2.3 MB · Đọc: 45
Upvote 0
minhchung_jazz đã viết:
Cảm ơn a Ba Tê rất nhiều ạ, tuy nhiên tôi lại gặp phải 1 trường hợp oái ăm và có thêm 3 câu hỏi, mong anh chỉ giáo cho người mới tìm hiểu VBA như tôi:
1. Khi bỏ "as string" hoặc khai báo thành Variant như anh thì gặp lỗi: "khi tôi xóa hết dữ liệu ở cột B thì chạy code nó tự cộng tổng thành giá trị 2380 tất cả các dòng từ H5 đến dòng cuối cùng của cột H".
2. Nếu bây giờ bài toán của tôi phát sinh thêm việc: tôi muốn VBA tự động lookup những số liệu có ngày tháng mà sau khi tính tổng như sumif ở cột H thì đưa lên tương ứng ngày tháng có đã ghi sẵn hàng ngang ở hàng 2 (Điền vào hàng 3 hoặc hàng tương ứng bất kỳ dưới hàng 2 có mã tên giống mã tên cột H)thì sẽ viết code như thế nào anh nhỉ?
3: Nếu tại ô B2 tôi điền tay là 1 ngày bất kỳ thì từ ô C2 đến ô CZX2 tự động điền các ngày tiếp theo liên tiếp với ngày đã điền, sau đó lookup giá trị đã được sumif ở cột H tương ứng với ngày trên hàng 3 (tính từ ô B3). Mục hỏi 2 và 3 tôi đã làm đc công tác này bằng công thức hàm nhưng file có 30 sheet dữ liệu thì rất nặng nên muốn dùng VBA cho nhẹ hơn.
4: Nếu tôi thay ngược lại cột F (từ F5) là ngày tháng, cột B (Từ B5) là khối lượng thì phải viết code đổi lại thế nào để vẫn tính được?
Trân trọng cảm ơn phản hồi của a Ba Tê và các anh chị khác góp ý. (Vui lòng xem file đính kèm)
Nhấp chuột vào đây để mở rộng...
1/ Code chạy từ B5 xuống tới khi kết thúc dữ liệu cuối cùng, giống như kiểu bạn nhấn Ctrl+ Down, nếu từ B5 trờ xuống k có dữ liệu thì nó sẽ chạy tới ô cuối trong sheet cho nên kết quả sẽ trả về giống như bạn thấy.
2,3,4 => Bạn nên đưa file có dữ liệu đầy đủ, code viết mới ổn nhất.
 
Upvote 0
chào cả nhà, e có 1 file như dưới đây, nhờ cả nhà viết giúp em mã code thay thế hàm sumifs. công thức cần tính nằm ở sheet2 (thomas). công thức tính ở các ô TT1, TT2, TT3 ... cần thỏa mãn điều kiện = nhân viên, mã nhóm, lớn hơn ngày 1/7/2019 và nhỏ hơn ngày 31/7/2019. Em cảm ơn cả nhà
 

File đính kèm

  • 19071111111.xlsm
    488 KB · Đọc: 18
Upvote 0
Mình đang đau đầu với code VBA để thay thế hàm sumif. Dử liệu chứa vùng điều kiện và vùng cần tính tổng lấy từ Sheets("BK_NX") > kết quả có chứa điều kiện mình cần trên Sheets("M_SAP").
>>> Bạn nào có code hay cho mình tham khảo với nhé
 

File đính kèm

  • ABC.xlsm
    4.7 MB · Đọc: 93
Upvote 0
LinhlxTBS đã viết:
Mình đang đau đầu với code VBA để thay thế hàm sumif. Dử liệu chứa vùng điều kiện và vùng cần tính tổng lấy từ Sheets("BK_NX") > kết quả có chứa điều kiện mình cần trên Sheets("M_SAP").
>>> Bạn nào có code hay cho mình tham khảo với nhé
Nhấp chuột vào đây để mở rộng...
Bạn thử.
Mã: 
Sub tinhtong()
    Dim arr, i As Long, j As Long, lr As Long, dic As Object, dk As String, a As Long, kq() As Double, lr1 As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("M_sap")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 5 Then Exit Sub
         arr = .Range("B5:C" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 3)
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             dic.Item(dk) = i
         Next i
   End With
   With Sheets("bk_nx")
        lr1 = .Range("H" & Rows.Count).End(xlUp).Row
        arr = .Range("H6:K" & lr1).Value
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            a = dic.Item(dk)
            If a Then
               kq(a, 1) = kq(a, 1) + arr(i, 3)
               kq(a, 2) = kq(a, 2) + arr(i, 4)
               kq(a, 3) = kq(a, 1) - kq(a, 2)
            End If
       Next i
  End With
  With Sheets("M_sap")
       .Range("E5:G" & lr).Value = kq
  End With
End Sub
 
Upvote 0
snow25 đã viết:
Bạn thử.
Mã: 
Sub tinhtong()
    Dim arr, i As Long, j As Long, lr As Long, dic As Object, dk As String, a As Long, kq() As Double, lr1 As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("M_sap")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 5 Then Exit Sub
         arr = .Range("B5:C" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 3)
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             dic.Item(dk) = i
         Next i
   End With
   With Sheets("bk_nx")
        lr1 = .Range("H" & Rows.Count).End(xlUp).Row
        arr = .Range("H6:K" & lr1).Value
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            a = dic.Item(dk)
            If a Then
               kq(a, 1) = kq(a, 1) + arr(i, 3)
               kq(a, 2) = kq(a, 2) + arr(i, 4)
               kq(a, 3) = kq(a, 1) - kq(a, 2)
            End If
       Next i
  End With
  With Sheets("M_sap")
       .Range("E5:G" & lr).Value = kq
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Thật tuyệt vời. Cảm ơn Bạn nhiều nhiều nhé.
 
Upvote 0
Mình không rành về VBA nên lên đây nhờ các bạn giúp đỡ về code thay thế hàm sumifs. Mình có gửi File đính kèm, trong File mình đang dùng công thức. Chân thành cảm ơn các bạn!
 

File đính kèm

  • NhoGiupCodeThaySumifs.xlsm
    23.1 KB · Đọc: 27
Upvote 0
Ba Tê đã viết:
SUMIF với 5000 dòng chưa phải là "oải".
Muốn Sub thì tặng bạn cái này.
PHP: 
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([B5], [B5].End(xlDown)).Resize(, 5).Value2
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    If Not Dic.Exists(Tem) Then
        Dic.Add Tem, sArr(I, 5)
    Else
        Dic.Item(Tem) = Dic.Item(Tem) + sArr(I, 5)
    End If
Next I
For I = 1 To UBound(sArr, 1)
    dArr(I, 1) = Dic.Item(sArr(I, 1))
Next I
[H5].Resize(I - 1) = dArr
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Cho mình hỏi nếu bài này mà chỉ muốn điền kết quả vào dòng đầu tiên của điều kiện thì sửa lại như nào (kiểu như trong ảnh)
Untitled.png
 
Upvote 0
Xin trợ giúp Code VBA thay thế cho SUMIFS để tối ưu tốc độ
(Nếu sử dụng công thức Sumifs thì dữ liệu tăng lên 17mb và máy treo)
File có 2 sheet: sheet(Sum) trả kết quả tính tổng; sheet(Data) vùng cần tính tổng
1. vùng cần tính tổng sheet"Sum" W13:FFS571
2. ở sheet(Sum):
- ở cột A hàng nào =1 thì bỏ qua
- nếu cột A khác 1 và cột F (cùng hàng) không trống thì :với điều kiện hàng 8 và cột F = sheet(data). cột C và cột E thì:
+ Nếu ở hàng số 11: cột nào = 1 tính tổng sheet(data) cột G
+ : cột nào =2 tính tổng sheet(data) cột P
còn lại là bỏ qua
xin cảm ơn
P/S: file đính kèm em dùng 3 vòng lặp = (4218/3)*571*8,090=6,494,862,340 lần lặp~ 10 phút
=> quá lâu. Dữ liệu trong file là kết quả tham khảo sau 10 phút chạy code.
Mã: 
Sub Sum_data_manual()
    Dim SumArr(), Sarr()
    Dim i As Long, j As Long, l As Long, SLBan As Double, SLTralai As Double, TongBan As Double
    Dim SumLr As Long, SumLcol As Long, SLr As Long, SLcol As Long, TG As Double, TongTraLai As Double
     TG = Timer()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    SumLr = Sheet1.Range("F" & Rows.Count).End(xlUp).Row
    SumLcol = Sheet1.Cells(11, Columns.Count).End(xlToLeft).Column
    SumArr = Sheet1.Range("A8").Resize(SumLr - 8 + 1, SumLcol - 1 + 1) ' tu A8
    SLr = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
    SLcol = Sheet2.Cells(8, Columns.Count).End(xlToLeft).Column
    Sarr = Sheet2.Range("A8").Resize(SLr - 8 + 1, SLcol - 1 + 1) ' tu A8
    For i = 5 To UBound(SumArr, 1)
        If SumArr(i, 1) = Empty And SumArr(i, 6) <> "" Then
            For j = UBound(SumArr, 2) To 17 Step -3
                For l = 2 To UBound(Sarr, 1)
                    If SumArr(i, 6) = Sarr(l, 5) And SumArr(1, j) = Sarr(l, 3) Then
                        If SumArr(4, j) = "3=1-2" Then
                            SLTralai = SumArr(i, j - 1) + Sarr(l, 16)
                            SumArr(i, j - 1) = Round(SLTralai, 2)
                            
                            SLBan = SumArr(i, j - 2) + Sarr(l, 7)
                            SumArr(i, j - 2) = Round(SLBan, 2)
                            SumArr(i, j) = Round(SLBan - SLTralai, 2)
                            
                            SLBan = 0: SLTralai = 0
                        End If
                    End If
                Next l
            Next j
        End If
    Next i
    Sheet1.Range("A8").Resize(SumLr - 8 + 1, SumLcol - 1 + 1) = SumArr
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "Done " & Round(Timer() - TG, 2)
End Sub
1589183726652.png
 

File đính kèm

  • SumData.xlsb
    4.1 MB · Đọc: 27
Upvote 0
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

H
Sửa code tính lũy kế ạ
Trả lời
3
Đọc
15
Hoàng Tuấn 868
H
Quyen182
  • Question
Nhờ chỉnh code VBA để tô màu dòng chứa Activecell và không làm mất màu gốc
Trả lời
3
Đọc
73
HeSanbi
HeSanbi
H
Nhờ hướng dẫn tạo bảng như hình vẽ
Trả lời
0
Đọc
22
hoaiantrinh
H
L
Đổi màu chữ trong VBA
Trả lời
11
Đọc
100
lvh1064
L
V
Chỉ cách sửa lỗi trong Excell
Trả lời
1
Đọc
29
A-T
A
T
Không đếm dữ liệu rỗng trong PivotTable
Trả lời
9
Đọc
1K
Dũng NĐ
Dũng NĐ
H
Hỗ trợ lấy danh sách dữ liệu thỏa mãn điều kiện
Trả lời
3
Đọc
137
DeTong
D
PhanTuHuong
Bàn về môn thể thao bóng bàn nào!
    • Thích
    • Yêu thích
    • Cười
2
Trả lời
38
Đọc
2K
lvh1064
L
salam
Ẩn ảnh sau chữ trong excel
Trả lời
11
Đọc
29K
itusbbk
itusbbk
nobita994
Trừ số lượng dần theo dòng khi quét Sumif tổng có tên sản phẩm bị trùng.
Trả lời
4
Đọc
125
nobita994
nobita994
F
  • Question
Nhờ tư vấn cách tạo QR trong Excel
Trả lời
7
Đọc
552
huuthang_bd
huuthang_bd
nguyen trung cuong
File chứa marco không mở được.
Trả lời
3
Đọc
108
hvnhpro
H
Tienvinh191
  • Question
Nhờ viết Code lấy dữ liệu tờ khai hải quan vào bảng tổng hợp
2
Trả lời
25
Đọc
2K
haott
H
CodyPham97
tạo biểu tượng thay thế nhấn đúp chuột
Trả lời
4
Đọc
94
phansythao
phansythao
dovanha1994
Giúp e tìm nguyên nhân sai và hướng dẫn e đọc file này với ạ
    • Phẫn nộ
Trả lời
4
Đọc
134
SA_DQ
SA_DQ
20050911
File Excel lỗi ''The file could not be accessed. Try one of the following:.."
Trả lời
10
Đọc
605
20050911
20050911
N
Giúp sửa mã code
2
Trả lời
20
Đọc
470
Nguyễn Diêu Hiền
N
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11/2024
    • Thích
    • Yêu thích
Trả lời
1
Đọc
101
SA_DQ
SA_DQ
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
32
Đọc
891
VetMini
V
K
Nhờ mọi người hoàn thiện giúp công thức
Trả lời
4
Đọc
124
kiendt1973
K
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

Back
Top Bottom