Nhờ viết giùm code thôay thế hàm sumifs cho 300,000 ô dữ liệu (1 người xem)

[phuplix]

Dear các anh

Nhờ các anh giúp em viết code để thay thế cho các hàm sumifs mà em làm cho file đính kèm

Với hàm sumifs này mà cho vô 300,000 ô dữ liệu của em thì nó lê lết đến là tội nghiệp.


Tiện thể các anh cho em hỏi ngoài vba thì có hàm nào khác thay thế cho sumifs mà chạy nhanh hơn không các anh ?

Xin cám ơn 500 anh em tốt bụng !

P/S: Không hiểu sao em đính kèm file lên mà cứ bị báo lỗi hoài
Các anh chịu khó download file trên fshare giùm em nha.

https://www.fshare.vn/file/RLCMWE1KKS1I

 

[quanluu]

Dear các anh

Nhờ các anh giúp em viết code để thay thế cho các hàm sumifs mà em làm cho file đính kèm

Với hàm sumifs này mà cho vô 300,000 ô dữ liệu của em thì nó lê lết đến là tội nghiệp.


Tiện thể các anh cho em hỏi ngoài vba thì có hàm nào khác thay thế cho sumifs mà chạy nhanh hơn không các anh ?

Xin cám ơn 500 anh em tốt bụng !

P/S: Không hiểu sao em đính kèm file lên mà cứ bị báo lỗi hoài
Các anh chịu khó download file trên fshare giùm em nha.

https://www.fshare.vn/file/RLCMWE1KKS1I

Tại sao lại phải code nhỉ. Bạn chỉ cần pivot table nhé.

 

[phuplix]

Không được bác ơi

Bởi vì cột danh sách bên sheet Wholesales sẽ có các data không xuất hiện bên shet database
mà em thì cần tính tổng dò tìm theo sheet database nên dùng pivot table bên sheet database sẽ không chính xác

bác viết code giúp em nhé

 

[quanluu]

Không được bác ơi

Bởi vì cột danh sách bên sheet Wholesales sẽ có các data không xuất hiện bên shet database
mà em thì cần tính tổng dò tìm theo sheet database nên dùng pivot table bên sheet database sẽ không chính xác

bác viết code giúp em nhé

Bạn kt code này xem chuẩn chưa?
nếu ok rùi thì bạn thay Range("O2").copy... thành Range("A2").copy....

Sub Tonghop()
    Dim query As String, lr, lr1 As Long, i As Integer, cot As String, tong As String
    lr = Sheets("Database").Range("C" & Rows.Count).End(3).Row
    lr1 = Range("A" & Rows.Count).End(3).Row
    For i = 3 To 12
        query = query + "left join (select f1, sum(f6) as km" & Cells(1, i) & " from [Database$C6:H" & lr & "] where f5 = " & Cells(1, i) & " group by f1) a" & Cells(1, i) & " on a.f1 = a" & Cells(1, i) & ".f1) " & Chr(10)
        cot = cot & ", km" & Cells(1, i)
        tong = tong & "+ iif(km" & Cells(1, i) & " is null, 0, km" & Cells(1, i) & ")"
    Next
    tong = Right(tong, Len(tong) - 1)
    query = "select a.f1,a.f2" & cot & ", " & tong & " from ((((((((([Wholesales date$A2:B" & lr1 & "] a " & Chr(10) & Left(query, Len(query) - 3)
'    Range("A2:M" & lr1).Clear
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
    Range("O2").CopyFromRecordset cn.Execute(query)
End Sub

 

[ChanhTQ@]

Con macro này cần tiêu tốn ~ 2 gy

 

[doveandrose]

Bạn kt code này xem chuẩn chưa?
nếu ok rùi thì bạn thay Range("O2").copy... thành Range("A2").copy....

Sub Tonghop()
    Dim query As String, lr, lr1 As Long, i As Integer, cot As String, tong As String
    lr = Sheets("Database").Range("C" & Rows.Count).End(3).Row
    lr1 = Range("A" & Rows.Count).End(3).Row
    For i = 3 To 12
        query = query + "left join (select f1, sum(f6) as km" & Cells(1, i) & " from [Database$C6:H" & lr & "] where f5 = " & Cells(1, i) & " group by f1) a" & Cells(1, i) & " on a.f1 = a" & Cells(1, i) & ".f1) " & Chr(10)
        cot = cot & ", km" & Cells(1, i)
        tong = tong & "+ iif(km" & Cells(1, i) & " is null, 0, km" & Cells(1, i) & ")"
    Next
    tong = Right(tong, Len(tong) - 1)
    query = "select a.f1,a.f2" & cot & ", " & tong & " from ((((((((([Wholesales date$A2:B" & lr1 & "] a " & Chr(10) & Left(query, Len(query) - 3)
'    Range("A2:M" & lr1).Clear
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
    Range("O2").CopyFromRecordset cn.Execute(query)
End Sub

nghe nói dữ liệu có thể là 300,000 dòng sao bạn dũng cảm dùng ADO vậy ? bạn có cách khiến ADO đọc được nhiều hơn 65,000 dòng ư ? hi hi

 

[quanluu]

nghe nói dữ liệu có thể là 300,000 dòng sao bạn dũng cảm dùng ADO vậy ? bạn có cách khiến ADO đọc được nhiều hơn 65,000 dòng ư ? hi hi

Quả này thì em phải coi lại rùi. Đúng thật là ADO giới hạn cột (255) và dòng. Chắc phải nghỉ chơi với ADO quá. Vì nó giói hạn và tốc độ chậm hơn hẳn Mảng và dic.

 

[doveandrose]

Bắt lỗi bạn hiền... 300 ngàn ô....chứ hổng fải 300 ngàn dòng.....

ờ không phải 300,000 dòng thì hên xui , bạn @quanluu1989 cho mình xin lổi nha .
Cuối tuần giải trí tí code chơi

Public Sub hello()
Dim r As Long, c As Long, arr, Dic As Object, cols, dArr, uc As Long
Set Dic = CreateObject("Scripting.Dictionary")
arr = Sheet1.Range("C6:H" & Sheet1.[C1000000].End(xlUp).Row).Value
For r = 1 To UBound(arr) Step 1
    Dic(arr(r, 1) & ";" & arr(r, 5)) = Dic(arr(r, 1) & ";" & arr(r, 5)) + Val(arr(r, 6))
Next
With Sheet2
    arr = .Range("A2:A" & .[A1000000].End(xlUp).Row).Value
    cols = .[C1:L1].Value
    uc = UBound(cols, 2)
    ReDim dArr(1 To UBound(arr), 1 To uc + 1)
    For r = 1 To UBound(arr) Step 1
        For c = 1 To uc Step 1
            dArr(r, c) = Val(Dic(arr(r, 1) & ";" & cols(1, c)))
            dArr(r, uc + 1) = dArr(r, uc + 1) + dArr(r, c)
        Next
    Next
    .Range("C2").Resize(UBound(dArr), UBound(dArr, 2)).Value = dArr
End With
End Sub

 

[phuongtrannhat1409]

Quả này thì em phải coi lại rùi. Đúng thật là ADO giới hạn cột (255) và dòng. Chắc phải nghỉ chơi với ADO quá. Vì nó giói hạn và tốc độ chậm hơn hẳn Mảng và dic.

Bạn có tài liệu về phần ADO giới hạn cột (255) và dòng không, cho mình ngâm cứu với. Trước giờ cũng nghĩ ADO xử lý toàn bộ dữ liệu chứ, hix

 

[HieuCD]

mình xin góp thêm code Dictionary

Public Sub GPE()
Dim r As Long, c As Integer, i As Long, Dic As Object, arr, Rarr, dArr
Set Dic = CreateObject("Scripting.Dictionary")
Rarr = Sheet2.Range("A2:A" & Sheet2.[A65000].End(xlUp).Row).Value
For i = 1 To UBound(Rarr) Step 1
    Dic(Rarr(i, 1)) = i
Next i
dArr = Sheet1.Range("C6:H" & Sheet1.[C65000].End(xlUp).Row).Value
ReDim arr(1 To UBound(Rarr), 1 To 11)
For i = 1 To UBound(dArr) Step 1
    If Dic.exists(dArr(i, 1)) Then
        r = Dic(dArr(i, 1))
        c = Int(dArr(i, 5) / 5000) + 1
        arr(r, c) = dArr(i, 6)
        arr(r, 11) = arr(r, 11) + dArr(i, 6)
    End If
Next i
Set Dic = Nothing
Sheet2.Range("C2").Resize(UBound(arr), UBound(arr, 2)).Value = arr
End Sub

 

[quanluu]

Bạn có tài liệu về phần ADO giới hạn cột (255) và dòng không, cho mình ngâm cứu với. Trước giờ cũng nghĩ ADO xử lý toàn bộ dữ liệu chứ, hix

Mình không có bạn. Bạn có thể search trên mạng.

 

[phuongtrannhat1409]

Mình không có bạn. Bạn có thể search trên mạng.

Mình search sáng giờ k thấy nội dung này nhỉ, mình cũng test thử với dữ liệu 1 triệu dòng, ADO vẫn xử lý ngon lành. Hoang mang quá

 

[quanluu]

Mình search sáng giờ k thấy nội dung này nhỉ, mình cũng test thử với dữ liệu 1 triệu dòng, ADO vẫn xử lý ngon lành. Hoang mang quá

Chào bạn, mình cũng vừa search lại kiểm tra thì thấy nó không giới hạn về dòng nhé. Nhưng chắc chắn là giới hạn 255 cột. Mình đang coi thêm các bài viết khác. Nhưng mình thấy ADO với dữ liệu lớn thì chậm hơn hẳn code khác nên mình nghĩ không nên dùng ADO với dữ liệu lớn làm gì cả. hi