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

Trạng thái
Không mở trả lời sau này.
M

mrbomst

Yêu THVBA
Ngày Mới nó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
Nhấn để mở rộng...
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 ạ.
 
N

NT24

Yêu THVBA
NhanSu nó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
Nhấn để mở rộng...
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 ?
 
N

NhanSu

SMod
Thành viên BQT
@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).
 
S

Sangista

Yêu THVBA
Ngày Mới nó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
Nhấn để mở rộng...
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 ạ?
 
D

Deleted member 1392

Guest
@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
 
S

Sangista

Yêu THVBA
Ngày Mới nó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
Nhấn để mở rộng...

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 ạ.
 
M

mrbomst

Yêu THVBA
Sangista nó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 ạ.
Nhấn để mở rộng...
Bạn thay đổi điều kiện if là được
 
Y

yibo

Yêu THVBA
Ngày Mới nó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
Nhấn để mở rộng...
anh cho e hỏi là nếu cột F(mã loại) có 2 ký tự mà e chỉ cần tách 1 ký tự phía sau thôi thì e nên viết thêm cấu trúc gì vào bước nào để tách được Mã ạ
 
N

NhanSu

SMod
Thành viên BQT
@yibo bạn không trích dẫn cả bài viết, hãy sử dụng @ kèm tên nick, nếu cần có thể ghi rõ code ở bài số mấy. Về câu hỏi, bạn nên lập chủ đề mới và gửi file đính kèm do chủ đề này cũ rồi.
 
Trạng thái
Không mở trả lời sau này.
Top