Nhờ viết code tính tổng theo nhiều điều kiện!

mrbomst

Thành viên mới
@mrbomst Thử lại code này xem tốc độ có tăng lên không bạn?
Mã:
Sub ThV()
Dim arrIn, arrDK, arrOut As Variant
Dim i, j, numS As Long
Dim KeyS As String
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")

'//INPUT
arrIn = Range("C4:G" & Range("C1000000").End(xlUp).Row).Value
arrDK = Range("M4:R" & Range("M1000000").End(xlUp).Row).Value
numS = 4

'//PROCESS
ReDim arrOut(1 To UBound(arrDK, 1), 1 To UBound(arrDK, 2) - numS + 1)
For i = LBound(arrIn, 1) To UBound(arrIn, 1)

    KeyS = arrIn(i, 1) & arrIn(i, 4)
    If Not Dic.Exists(KeyS) Then
        Dic.Add KeyS, arrIn(i, 5)
    Else
        Dic.Item(KeyS) = Dic.Item(KeyS) + arrIn(i, 5)
    End If

Next i

For i = LBound(arrDK, 1) To UBound(arrDK, 1)
    For j = numS To UBound(arrDK, 2)
   
        KeyS = arrDK(i, 1) & arrDK(i, j)
        If Dic.Exists(KeyS) Then
            arrOut(i, j - numS + 1) = Dic.Item(KeyS)
        End If
    Next j
Next i

'//OUTPUT
Range("T4:V" & Range("M1000000").End(xlUp).Row).Value = arrOut

End Sub
Woww... Đúng là sử dụng dictionary cho tốc độ nhanh khủng khiếp ạ. em xin cảm ơn bác nhiều ạ. sử dụng mảng thì em hiểu chứ dùng dic này vẫn mơ hồ quá. cần phải học hỏi thêm nhiều từ các bác nữa ạ.
 

NT24

Thành viên mới
Option Explicit #Const xxx = True Sub ABC() #If xxx Then Dim Dic As New Dictionary #Else Dim Dic As Object Set Dic = CreateObject("Scripting.Dictionary") #End If
Bạn cho tôi hỏi về tác dụng của dấu # và cách dùng của nó trong đoạn code trên được không?và có tài liệu nào tham khảo thì cho tôi xin link được không ?
 

NhanSu

Thành Viên Nổi Bật

@NT24 bạn tra Google "conditional compilation vba" sẽ có nhiều hướng dẫn. Tiếng Việt hay gọi là dẫn hướng biên dịch hay dẫn hướng thông dịch (directive compiler - interpreter).
 

Sangista

Thành viên mới
@mrbomst Thử lại code này xem tốc độ có tăng lên không bạn?
Mã:
Sub ThV()
Dim arrIn, arrDK, arrOut As Variant
Dim i, j, numS As Long
Dim KeyS As String
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")

'//INPUT
arrIn = Range("C4:G" & Range("C1000000").End(xlUp).Row).Value
arrDK = Range("M4:R" & Range("M1000000").End(xlUp).Row).Value
numS = 4

'//PROCESS
ReDim arrOut(1 To UBound(arrDK, 1), 1 To UBound(arrDK, 2) - numS + 1)
For i = LBound(arrIn, 1) To UBound(arrIn, 1)

    KeyS = arrIn(i, 1) & arrIn(i, 4)
    If Not Dic.Exists(KeyS) Then
        Dic.Add KeyS, arrIn(i, 5)
    Else
        Dic.Item(KeyS) = Dic.Item(KeyS) + arrIn(i, 5)
    End If

Next i

For i = LBound(arrDK, 1) To UBound(arrDK, 1)
    For j = numS To UBound(arrDK, 2)
   
        KeyS = arrDK(i, 1) & arrDK(i, j)
        If Dic.Exists(KeyS) Then
            arrOut(i, j - numS + 1) = Dic.Item(KeyS)
        End If
    Next j
Next i

'//OUTPUT
Range("T4:V" & Range("M1000000").End(xlUp).Row).Value = arrOut

End Sub
Hi bác, cho mình hỏi Nums trong đây là gì nhỉ? Mình đưa vào bảng tính mình đổi cột điều kiện thì nó không ra ạ?
 

Ngày Mới

Thành viên tích cực
@Sangista Là số cột bắt đầu điều kiện.
NumS = 4 có nghĩa là số cột bắt đầu vùng điều kiện 2 sẽ bắt đầu ở cột số 4 đến cột cuối cùng trong vùng được chọn.
Bạn cần đăng nhập để thấy hình ảnh
 

Sangista

Thành viên mới
@Sangista Là số cột bắt đầu điều kiện.
NumS = 4 có nghĩa là số cột bắt đầu vùng điều kiện 2 sẽ bắt đầu ở cột số 4 đến cột cuối cùng trong vùng được chọn.
Bạn cần đăng nhập để thấy hình ảnh

Hì, cảm ơn Bác nhiều. sẵn tiện cho mình hỏi nếu muốn tính loại điều kiện >= 1 giá trị vd: ở mã loại thay vì A,B,C thì của mình là giá trị số 1,2,3 và mình muốn tính sum điều kiện MH001 và điều kiện là >=2 có bao nhiêu. Nhờ cao thủ giúp ạ.
 

mrbomst

Thành viên mới
Hì, cảm ơn Bác nhiều. sẵn tiện cho mình hỏi nếu muốn tính loại điều kiện >= 1 giá trị vd: ở mã loại thay vì A,B,C thì của mình là giá trị số 1,2,3 và mình muốn tính sum điều kiện MH001 và điều kiện là >=2 có bao nhiêu. Nhờ cao thủ giúp ạ.
Bạn thay đổi điều kiện if là được
 
Top