Giúp đỡ giải pháp thay hàm Sumif khi dữ liệu lớn. (1 người xem)

[phuyen89]

Chào mọi người!
[FONT=&amp]Sở dĩ em nhờ mọi người viết code thay hàm Sumif vì số lượng dòng của em rất lớn.Một tháng khoảng 20.000 dòng.Trong VBA em sử dụng Application.worksheetfunction. Sumif nhưng khi dữ liệu rất lớn nó trở nên chạy rất ì ạch. Mong mọi người có giải pháp khắc phục cho em học hỏi.[/FONT]

[FONT=&amp]Yêu cầu như sau:[/FONT]

· [FONT=&amp]Cột C: Tính số tiền phải Phải Thu hộ có Vùng là C3:C20.000, điều kiện B4 tại sheet Data, Vùng cần tính Tổng là C3: C20.000[/FONT]

· [FONT=&amp]Cột D: Tính số tiền phải Thu phí có Vùng là D320.000, điều kiện B4 tại sheet Data, Vùng cần tính Tổng là D3: D20.000[/FONT]
Mong mọi người giúp đỡ.

 

[ndu96081631]

Chào mọi người!
[FONT=&amp]Sở dĩ em nhờ mọi người viết code thay hàm Sumif vì số lượng dòng của em rất lớn.Một tháng khoảng 20.000 dòng.Trong VBA em sử dụng Application.worksheetfunction. Sumif nhưng khi dữ liệu rất lớn nó trở nên chạy rất ì ạch. Mong mọi người có giải pháp khắc phục cho em học hỏi.[/FONT]

[FONT=&amp]Yêu cầu như sau:[/FONT]

· [FONT=&amp]Cột C: Tính số tiền phải Phải Thu hộ có Vùng là C3:C20.000, điều kiện B4 tại sheet Data, Vùng cần tính Tổng là C3: C20.000[/FONT]

· [FONT=&amp]Cột D: Tính số tiền phải Thu phí có Vùng là D320.000, điều kiện B4 tại sheet Data, Vùng cần tính Tổng là D3: D20.000[/FONT]
Mong mọi người giúp đỡ.

Thế thì ta dùng PivotTable mà tổng hợp cho khỏe, cần gì code hay công thức chứ?

 

[phuyen89]

Thế thì ta dùng PivotTable mà tổng hợp cho khỏe, cần gì code hay công thức chứ?

Dạ, cấu trúc hơi đặc biết với lại còn xử lý dữ liệu này nữa, nên mong Thầy giúp đỡ.

 

[ndu96081631]

Dạ, cấu trúc hơi đặc biết với lại còn xử lý dữ liệu này nữa, nên mong Thầy giúp đỡ.

Toàn bộ giải thuật bài này nằm trong chữ ký của bạn đó! Mở ra xem và áp dụng

 

[concogia]

Toàn bộ giải thuật bài này nằm trong chữ ký của bạn đó! Mở ra xem và áp dụng

Cái này thì "ô kê" nhưng dữ liệu của bạn í không chuẩn, cột B ở sheet Data không duy nhất mà có tới 332 dữ liệu trùng nên kết quả ?????????????

 

[phuyen89]

Dạ không sao, em viết code dùng 2 vòng for mà nó cũng chậm quá. Đang nghiên cứu chuyển sang array,nên mong mọi ngươif giúp trước để làm việc.

 

[ndu96081631]

Cái này thì "ô kê" nhưng dữ liệu của bạn í không chuẩn, cột B ở sheet Data không duy nhất mà có tới 332 dữ liệu trùng nên kết quả ?????????????

Vùng kết quả mà anh! Trùng hay không trùng cũng đâu có sao!
Nếu em làm thì em sẽ dẹp hết "khu vực" tạo sẵn ở sheet Data, làm lại kết quả có được từ Dic
(bài dạng này chắc cũng được "tám chục lần" đăng trên diễn đàn rồi nhỉ? )
--------------------------

Đang nghiên cứu chuyển sang array,nên mong mọi ngươif giúp trước để làm việc.

Chẳng phải Array và Dictionary đều là món bạn đặt trong chữ ký đó sao?

 

[phuyen89]

Vùng kết quả mà anh! Trùng hay không trùng cũng đâu có sao!
Nếu em làm thì em sẽ dẹp hết "khu vực" tạo sẵn ở sheet Data, làm lại kết quả có được từ Dic
(bài dạng này chắc cũng được "tám chục lần" đăng trên diễn đàn rồi nhỉ? )

--------------------------

Dạ không được xóa dữ liệu có sẵn nhé Anh!
Công ty em là bên Vận chuyển hàng có thu hộ cho Khách hàng, sheet Data đó là những vận đơn đã giao hoàn thành cho Khách.
Sheet Thu tiền, là những vận đơn đã nộp tiền rồi. Nếu bình thường sẽ dùng hàm Sumif để tính tổng theo từng vận đơn, từ đó trừ chênh lệch ra, biết vận đơn nào chưa thu tiền hay đã thu tiền,

 

[ndu96081631]

Dạ không được xóa dữ liệu có sẵn nhé Anh!
Công ty em là bên Vận chuyển hàng có thu hộ cho Khách hàng, sheet Data đó là những vận đơn đã giao hoàn thành cho Khách.
Sheet Thu tiền, là những vận đơn đã nộp tiền rồi. Nếu bình thường sẽ dùng hàm Sumif để tính tổng theo từng vận đơn, từ đó trừ chênh lệch ra, biết vận đơn nào chưa thu tiền hay đã thu tiền,

- Tại sheet ThuTien, toàn bộ dữ liệu cho vào mảng
- Duyệt từ trên xuống (cột B). Cái nào chưa có thì cho vào Dictionary, có rồi thì cộng dồn (vào Item). Ở Item, có thể tạo mảng 2 phần tử để chứa "Thu hộ" và "Phí"
- Tiếp theo, tại sheet Data, đặt B42000 thành 1 mảng. Duyệt từ trên xuống (cột đầu). Tra vào Dictionary, thấy có thì lấy Item ra gán vào cột 2 và 3
- Xong việc, "đập" 1 phát xuống bảng tính
Xong!

 

[phuyen89]

- Tại sheet ThuTien, toàn bộ dữ liệu cho vào mảng
- Duyệt từ trên xuống (cột B). Cái nào chưa có thì cho vào Dictionary, có rồi thì cộng dồn (vào Item). Ở Item, có thể tạo mảng 2 phần tử để chứa "Thu hộ" và "Phí"
- Tiếp theo, tại sheet Data, đặt B42000 thành 1 mảng. Duyệt từ trên xuống (cột đầu). Tra vào Dictionary, thấy có thì lấy Item ra gán vào cột 2 và 3
- Xong việc, "đập" 1 phát xuống bảng tính
Xong!

Dạ. Em sẽ code theo giải thuật trên, có sai sót rồi nhờ mọi người giúp đỡ.

 

[phuyen89]

- Tại sheet ThuTien, toàn bộ dữ liệu cho vào mảng
- Duyệt từ trên xuống (cột B). Cái nào chưa có thì cho vào Dictionary, có rồi thì cộng dồn (vào Item). Ở Item, có thể tạo mảng 2 phần tử để chứa "Thu hộ" và "Phí"
- Tiếp theo, tại sheet Data, đặt B42000 thành 1 mảng. Duyệt từ trên xuống (cột đầu). Tra vào Dictionary, thấy có thì lấy Item ra gán vào cột 2 và 3
- Xong việc, "đập" 1 phát xuống bảng tính
Xong!

Dạ, em mới có Cộng Số tiền của từng vận đơn đưa vào Dic thôi, em chưa làm được lấy từng phần tử của mảng Data dò trong Dic.
Em code mới được như thế này thôi:

Sub TinhTong()
    Dim ArrThuTien() As Variant
    Dim ArrData() As Variant
    Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    ArrThuTien = Range("H4", Range("H65000").End(xlUp)).Resize(, 2)
    ArrData = Range("B4", Range("B65000").End(xlUp)).Resize(, 2)
    For i = 1 To UBound(ArrThuTien)
        tem = ArrThuTien(i, 1)
        If Not Dic.exists(tem) Then
            Dic.Add tem, ArrThuTien(i, 2)
        Else
            Dic(tem) = Dic.Item(tem) + ArrThuTien(i, 2)
        End If
        
    Next i
    
    
End Sub

 

[diemhuyenanh]

tôi làm bạn xem có đúng ý không nhé

 

[phuyen89]

tôi làm bạn xem có đúng ý không nhé

Thử lại với hàm Sumif bị trật hơn khoảng 500 dòng, bạn xem lại giúp nhé. Mình cũng đang tìm vì sao??

 

[diemhuyenanh]

trật là trật thế nào bạn nói rõ hơn bằng file có hàm sumif lên xem thế nào

 

[phihndhsp]

trật là trật thế nào bạn nói rõ hơn bằng file có hàm sumif lên xem thế nào

Bạn làm với DIC thì nên lưu ý, dữ liệu là chữ hoa và chữ thường, dữ liệu là text và số, nên cẩn thận mấy cái đó khi làm DIC.
những dạng này muốn kiểm tra đúng hay không thì chỉ cần xét tổng 2 bên xem có khớp hay không?
tôi nhìn và test sơ qua thấy không đúng nhiều chỗ rồi, bạn sửa code lại dùm cho người ta đi, lỡ giúp thì giúp thì giúp cho trót luôn

 

[diemhuyenanh]

BẠN CHÉP CODE NÀY ĐÈ LÊN CODE CŨ NHÉ

Sub TinhTong()
Dim ArrThuTien(), ArrData(), Darr(), i As Long, iT As Long
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Dic.comparemode = vbTextCompare
ArrThuTien = Range("H4", Range("H65000").End(xlUp)).Resize(, 3).Value
ArrData = Range("B4", Range("B65536").End(xlUp)).Value
ReDim Darr(1 To UBound(ArrData, 1), 1 To 2)
For i = 1 To UBound(ArrData, 1)
tem = Trim(ArrData(i, 1))
If Not Dic.exists(tem) Then
Dic.Add tem, i
End If
Next i
For iT = 1 To UBound(ArrThuTien, 1)
If Dic.exists(trim(ArrThuTien(iT, 1))) Then
Darr(Dic.Item(trim(ArrThuTien(iT, 1))), 1) = Darr(Dic.Item(trim(ArrThuTien(iT, 1))), 1) + ArrThuTien(iT, 2)
Darr(Dic.Item(trim(ArrThuTien(iT, 1))), 2) = Darr(Dic.Item(trim(ArrThuTien(iT, 1))), 2) + ArrThuTien(iT, 3)
End If
Next iT
Range("C4").Resize(UBound(Darr, 1), 2) = Darr
End Sub

 

[comet_1701]

Thử lại với hàm Sumif bị trật hơn khoảng 500 dòng, bạn xem lại giúp nhé. Mình cũng đang tìm vì sao??

Sub Dictionary()
Dim Dic As Object, Ws As Worksheet, sArr(), Darr(), tArr(), i As Long
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Data")
Set Dic = CreateObject("Scripting.Dictionary")
tArr = Sh.Range(Sh.[B4], Sh.[B65000].End(xlUp)).Value2
ReDim Darr(1 To UBound(tArr, 1), 1 To 2)
For i = 1 To UBound(tArr, 1)
    Dic.Item(tArr(i, 1)) = i
Next i
With Sheets("ThuTien")
    sArr = .Range(.[B3], .[B65000].End(xlUp)).Resize(, 3).Value2
End With


        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) Then
                Darr(Dic.Item(sArr(i, 1)), 1) = Darr(Dic.Item(sArr(i, 1)), 1) + sArr(i, 2)
                Darr(Dic.Item(sArr(i, 1)), 2) = Darr(Dic.Item(sArr(i, 1)), 2) + sArr(i, 3)
            End If
        Next i
    Sh.[C4:D65000].ClearContents
    Sh.[C4].Resize(UBound(Darr), 2) = Darr


Set Dic = Nothing
End Sub

Mình chưa kịp te st đâu, chỉ nêu ý tưởng thôi. chúc bạn thành công

 

[phuyen89]

Sub Dictionary()
Dim Dic As Object, Ws As Worksheet, sArr(), Darr(), tArr(), i As Long
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Data")
Set Dic = CreateObject("Scripting.Dictionary")
tArr = Sh.Range(Sh.[B4], Sh.[B65000].End(xlUp)).Value2
ReDim Darr(1 To UBound(tArr, 1), 1 To 2)
For i = 1 To UBound(tArr, 1)
    Dic.Item(tArr(i, 1)) = i
Next i
With Sheets("ThuTien")
    sArr = .Range(.[B3], .[B65000].End(xlUp)).Resize(, 3).Value2
End With




        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) Then
                Darr(Dic.Item(sArr(i, 1)), 1) = Darr(Dic.Item(sArr(i, 1)), 1) + sArr(i, 2)
                Darr(Dic.Item(sArr(i, 1)), 2) = Darr(Dic.Item(sArr(i, 1)), 2) + sArr(i, 3)
            End If
        Next i
    Sh.[C4:D65000].ClearContents
    Sh.[C4].Resize(UBound(Darr), 2) = Darr


Set Dic = Nothing
End Sub

Mình chưa kịp te st đâu, chỉ nêu ý tưởng thôi. chúc bạn thành công

Mình đã test rồi, vẫn lệch 318 row so với dùng hàm Sumif nên nhờ bạn xem lại giúp.

 

[phuyen89]

BẠN CHÉP CODE NÀY ĐÈ LÊN CODE CŨ NHÉ

Sub TinhTong()
Dim ArrThuTien(), ArrData(), Darr(), i As Long, iT As Long
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Dic.comparemode = vbTextCompare
ArrThuTien = Range("H4", Range("H65000").End(xlUp)).Resize(, 3).Value
ArrData = Range("B4", Range("B65536").End(xlUp)).Value
ReDim Darr(1 To UBound(ArrData, 1), 1 To 2)
For i = 1 To UBound(ArrData, 1)
tem = Trim(ArrData(i, 1))
If Not Dic.exists(tem) Then
Dic.Add tem, i
End If
Next i
For iT = 1 To UBound(ArrThuTien, 1)
If Dic.exists(trim(ArrThuTien(iT, 1))) Then
Darr(Dic.Item(trim(ArrThuTien(iT, 1))), 1) = Darr(Dic.Item(trim(ArrThuTien(iT, 1))), 1) + ArrThuTien(iT, 2)
Darr(Dic.Item(trim(ArrThuTien(iT, 1))), 2) = Darr(Dic.Item(trim(ArrThuTien(iT, 1))), 2) + ArrThuTien(iT, 3)
End If
Next iT
Range("C4").Resize(UBound(Darr, 1), 2) = Darr
End Sub

Vẫn còn chênh lệch khi so sánh với hàm Sumif.

 

[Hau151978]

Bạn thử code này xem sao. Trong cửa sổ VBA chọn Tools - Reference - Microsoft scripting runtime.

Sub TinhTong()
    Dim data(), kq(), i&, j&, n&, k, dic As Dictionary
    Sheets("thutien").Activate
    n = Range("B" & Columns(2).Rows.Count).End(xlUp).Row
    data = Range("B3:D" & n).Value2
    ReDim kq(1 To n - 2, 1 To 3)
    Set dic = New Dictionary
    For i = 1 To n - 2
        k = data(i, 1)
        If Not dic.Exists(k) Then
            j = j + 1
            dic.Add k, j
            kq(j, 1) = k
            kq(j, 2) = data(i, 2)
            kq(j, 3) = data(i, 3)
        Else
            kq(dic.Item(k), 2) = kq(dic.Item(k), 2) + data(i, 2)
            kq(dic.Item(k), 3) = kq(dic.Item(k), 3) + data(i, 3)
        End If
    Next
    Sheets("data").Activate
    Columns(2).NumberFormat = "@"
    Range("B4:D" & (j + 3)) = kq
    Set dic = Nothing
End Sub

Không biết có lệch với sumif không.