[Cần giúp đỡ] Chạy công thức cho khoảng 5000 dòng x 50 cột sau đó chuyển về giá trị cho nhẹ file (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

yeungannam003

Thành viên mới
Tham gia
15/12/20
Bài viết
9
Được thích
6
Chào mọi người!
Em mới nghiên cứu về VBA. Nhờ mọi người giúp chạy code như sau:
Sheet1 hằng ngày nhập thông tin chi tiết của lệnh sản xuất:ngày giao hàng, định mức vật tư cấp, tiến độ sx,.... 1 lệnh sx gồm nhiều dòng dữ liệu
Sheet2 để tổng hợp các lệnh sx lại, mỗi lệnh sx chỉ 1 dòng dữ liệu
Mong muốn của em là chạy công thức để tổng hợp ở sheet2 sau đó chuyển thành giá trị (chỉ để 1 dòng đầu tiên có công thức chỉnh sửa) để nhẹ file và việc nhập liệu hàng ngày ở sheet1 không ảnh hưởng, khi nào cần tổng hợp thì chạy macro ở sheet2
Dữ liệu khoảng 5000 dòng x 50 cột
Em có viết 2 code nhưng excel chạy không nổi, lưu file lên đến 10MB
Mong mọi người cho ý kiến về cách làm của em và chỉ cho code nào hiệu quả để chạy dữ liệu này.
File đính kèm em đã xóa bớt dữ liệu để tải lên
Chân thành cảm ơn!
 

File đính kèm

Hình như vấn đề của bạn là thiết kế lại CSDL;
 
Chào mọi người!
Em mới nghiên cứu về VBA. Nhờ mọi người giúp chạy code như sau:
Sheet1 hằng ngày nhập thông tin chi tiết của lệnh sản xuất:ngày giao hàng, định mức vật tư cấp, tiến độ sx,.... 1 lệnh sx gồm nhiều dòng dữ liệu
Sheet2 để tổng hợp các lệnh sx lại, mỗi lệnh sx chỉ 1 dòng dữ liệu
Mong muốn của em là chạy công thức để tổng hợp ở sheet2 sau đó chuyển thành giá trị (chỉ để 1 dòng đầu tiên có công thức chỉnh sửa) để nhẹ file và việc nhập liệu hàng ngày ở sheet1 không ảnh hưởng, khi nào cần tổng hợp thì chạy macro ở sheet2
Dữ liệu khoảng 5000 dòng x 50 cột
Em có viết 2 code nhưng excel chạy không nổi, lưu file lên đến 10MB
Mong mọi người cho ý kiến về cách làm của em và chỉ cho code nào hiệu quả để chạy dữ liệu này.
File đính kèm em đã xóa bớt dữ liệu để tải lên
Chân thành cảm ơn!
Làm như trong file của bạn, để Excel tính hết 5000 dòng công thức đó thì nó ì ạch là phải rồi. Cần phải tính trong VBA luôn, ghi kết quả vào 1 mảng rổi đổ vào trang tính mới nhanh được.
 
Sử dụng Dictionary và mảng
Ghi chú: công thức từ cột N trở về sau của bạn sai, tại sao lại là OK
N4==IF(A4<>"",SUMIF('spN3'!$A$4:$OK$585,A4,'spN3'!$P$4:$P$585),"")
Ngoài ra 3 cột AE, AF, AG công thức giống 3 cột X, Y, Z. Bạn tự xem và sửa code nếu cần

Xem file đính kèm, tôi đang ghi kết quả vào dòng 5, chừa dòng 4 của bạn lại, muốn về dòng 4 thì sửa code.
 

File đính kèm

Lần chỉnh sửa cuối:
Sửa 1 chút cho nhanh hơn, giảm 1/3 thời gian:
PHP:
Sub Tonghop()
Dim Dict1, SArr(), RArr(), LsxArr()
Dim LRw As Long, DictCount As Long, LsxNo As String, k As Long
Set Dict1 = CreateObject("Scripting.Dictionary")
LRw = Sheet1.[A100000].End(xlUp).Row
LsxArr = Sheet1.Range("A4:A" & LRw).Value
SArr = Sheet1.Range("A4:AI" & LRw).Value
Application.ScreenUpdating = False
t = Timer
For i = 1 To UBound(LsxArr, 1)
    If Not Dict1.exists(CStr(LsxArr(i, 1))) Then
        k = k + 1
        Dict1.Add CStr(LsxArr(i, 1)), k
    End If
Next
DictCount = Dict1.Count

ReDim RArr(1 To DictCount, 1 To 35)
For i = 1 To UBound(SArr, 1)
    LsxNo = SArr(i, 1)
    k = Dict1.Item(LsxNo)
    RArr(k, 1) = SArr(i, 1)
    RArr(k, 2) = SArr(i, 2)
    RArr(k, 3) = SArr(i, 3)
    RArr(k, 4) = SArr(i, 4)
    RArr(k, 5) = SArr(i, 7)
    RArr(k, 6) = SArr(i, 9)
    RArr(k, 7) = RArr(k, 7) + SArr(i, 6)
    RArr(k, 8) = RArr(k, 8) + SArr(i, 11)
    RArr(k, 9) = SArr(i, 10)
    RArr(k, 10) = RArr(k, 10) + SArr(i, 13)
    RArr(k, 11) = RArr(k, 11) + SArr(i, 14)
    RArr(k, 14) = RArr(k, 14) + SArr(i, 16)
    RArr(k, 15) = RArr(k, 15) + SArr(i, 17)
    RArr(k, 18) = Val(RArr(k, 18)) + Val(SArr(i, 19))
    RArr(k, 19) = RArr(k, 19) + SArr(i, 20)
    RArr(k, 23) = RArr(k, 23) + SArr(i, 23)
    RArr(k, 24) = RArr(k, 24) + SArr(i, 24)
    RArr(k, 25) = RArr(k, 25) + SArr(i, 25)
    RArr(k, 26) = RArr(k, 26) + SArr(i, 26)
    RArr(k, 27) = RArr(k, 27) + SArr(i, 27)
    RArr(k, 28) = RArr(k, 28) + SArr(i, 28)
    RArr(k, 29) = RArr(k, 29) + SArr(i, 29)
    RArr(k, 30) = RArr(k, 30) + SArr(i, 30)
    RArr(k, 31) = RArr(k, 31) + SArr(i, 31)
    RArr(k, 32) = RArr(k, 32) + SArr(i, 32)
    RArr(k, 33) = RArr(k, 33) + SArr(i, 33)
 
Next
Sheet3.[A5].Resize(5000, 35).ClearContents
Sheet3.[A5].Resize(DictCount, 35).Value = RArr
Application.ScreenUpdating = True
MsgBox Timer - t & " seconds", , "ptm0412"
       
       
End Sub
 
Sửa 1 chút cho nhanh hơn, giảm 1/3 thời gian:
PHP:
Sub Tonghop()
Dim Dict1, SArr(), RArr(), LsxArr()
Dim LRw As Long, DictCount As Long, LsxNo As String, k As Long
Set Dict1 = CreateObject("Scripting.Dictionary")
LRw = Sheet1.[A100000].End(xlUp).Row
LsxArr = Sheet1.Range("A4:A" & LRw).Value
SArr = Sheet1.Range("A4:AI" & LRw).Value
Application.ScreenUpdating = False
t = Timer
For i = 1 To UBound(LsxArr, 1)
    If Not Dict1.exists(CStr(LsxArr(i, 1))) Then
        k = k + 1
        Dict1.Add CStr(LsxArr(i, 1)), k
    End If
Next
DictCount = Dict1.Count

ReDim RArr(1 To DictCount, 1 To 35)
For i = 1 To UBound(SArr, 1)
    LsxNo = SArr(i, 1)
    k = Dict1.Item(LsxNo)
    RArr(k, 1) = SArr(i, 1)
    RArr(k, 2) = SArr(i, 2)
    RArr(k, 3) = SArr(i, 3)
    RArr(k, 4) = SArr(i, 4)
    RArr(k, 5) = SArr(i, 7)
    RArr(k, 6) = SArr(i, 9)
    RArr(k, 7) = RArr(k, 7) + SArr(i, 6)
    RArr(k, 8) = RArr(k, 8) + SArr(i, 11)
    RArr(k, 9) = SArr(i, 10)
    RArr(k, 10) = RArr(k, 10) + SArr(i, 13)
    RArr(k, 11) = RArr(k, 11) + SArr(i, 14)
    RArr(k, 14) = RArr(k, 14) + SArr(i, 16)
    RArr(k, 15) = RArr(k, 15) + SArr(i, 17)
    RArr(k, 18) = Val(RArr(k, 18)) + Val(SArr(i, 19))
    RArr(k, 19) = RArr(k, 19) + SArr(i, 20)
    RArr(k, 23) = RArr(k, 23) + SArr(i, 23)
    RArr(k, 24) = RArr(k, 24) + SArr(i, 24)
    RArr(k, 25) = RArr(k, 25) + SArr(i, 25)
    RArr(k, 26) = RArr(k, 26) + SArr(i, 26)
    RArr(k, 27) = RArr(k, 27) + SArr(i, 27)
    RArr(k, 28) = RArr(k, 28) + SArr(i, 28)
    RArr(k, 29) = RArr(k, 29) + SArr(i, 29)
    RArr(k, 30) = RArr(k, 30) + SArr(i, 30)
    RArr(k, 31) = RArr(k, 31) + SArr(i, 31)
    RArr(k, 32) = RArr(k, 32) + SArr(i, 32)
    RArr(k, 33) = RArr(k, 33) + SArr(i, 33)

Next
Sheet3.[A5].Resize(5000, 35).ClearContents
Sheet3.[A5].Resize(DictCount, 35).Value = RArr
Application.ScreenUpdating = True
MsgBox Timer - t & " seconds", , "ptm0412"
      
      
End Sub
Chú Mỹ ơi cái đoạn này có cách nào sử dụng For... thay thế được không ạ Chú?
Trừ cột nào nó khác biệt với các cột còn lại thì sẽ xử lý riêng ạ, nếu thêm 100 cột thế này thì con thấy code cũng cực ạ.
Mã:
RArr(k, 1) = SArr(i, 1)
    RArr(k, 2) = SArr(i, 2)
    RArr(k, 3) = SArr(i, 3)
    RArr(k, 4) = SArr(i, 4)
    RArr(k, 5) = SArr(i, 7)
    RArr(k, 6) = SArr(i, 9)
    RArr(k, 7) = RArr(k, 7) + SArr(i, 6)
    RArr(k, 8) = RArr(k, 8) + SArr(i, 11)
    RArr(k, 9) = SArr(i, 10)
    RArr(k, 10) = RArr(k, 10) + SArr(i, 13)
    RArr(k, 11) = RArr(k, 11) + SArr(i, 14)
    RArr(k, 14) = RArr(k, 14) + SArr(i, 16)
    RArr(k, 15) = RArr(k, 15) + SArr(i, 17)
    RArr(k, 18) = Val(RArr(k, 18)) + Val(SArr(i, 19))
    RArr(k, 19) = RArr(k, 19) + SArr(i, 20)
    RArr(k, 23) = RArr(k, 23) + SArr(i, 23)
    RArr(k, 24) = RArr(k, 24) + SArr(i, 24)
    RArr(k, 25) = RArr(k, 25) + SArr(i, 25)
    RArr(k, 26) = RArr(k, 26) + SArr(i, 26)
    RArr(k, 27) = RArr(k, 27) + SArr(i, 27)
    RArr(k, 28) = RArr(k, 28) + SArr(i, 28)
    RArr(k, 29) = RArr(k, 29) + SArr(i, 29)
    RArr(k, 30) = RArr(k, 30) + SArr(i, 30)
    RArr(k, 31) = RArr(k, 31) + SArr(i, 31)
    RArr(k, 32) = RArr(k, 32) + SArr(i, 32)
    RArr(k, 33) = RArr(k, 33) + SArr(i, 33)
 
Chỗ này bị lỗi khi LRw = 4 đó anh.
Ít khi xảy ra đối với dữ liệu này, vì có chi tiết mới cần tổng hợp chứ không có chi tiết nhấn nút làm chi. (Chi tiết nhập tay, chứ nếu chi tiết lấy từ phần mềm thì phải bắt lỗi)
Chú Mỹ ơi cái đoạn này có cách nào sử dụng For... thay thế được không ạ Chú?
Từ cột 23 trở về sau đó nhóc, tự xử đi. Còn chú thì copy 1 dòng code paste xuống 10 dòng rồi sửa số, nên không cực lắm
 
Chú Mỹ ơi cái đoạn này có cách nào sử dụng For... thay thế được không ạ Chú?
Trừ cột nào nó khác biệt với các cột còn lại thì sẽ xử lý riêng ạ, nếu thêm 100 cột thế này thì con thấy code cũng cực ạ.
...
Được, nhưng với lý do khác. Lý do "code cũng cực" không chính đáng lắm (*)

For d2 = 1 To 33
Select Case d2
Case 1 To 4
RArr(k, d2) = SArr(i, d2)
Case 5
RArr(k, d2) = SArr(i, d2+ 2)
Case 6
RArr(k, d2) = SArr(i, d2 + 3)
Case 7
RArr(k, d2) = RArr(k, d2) + SArr(i, d2 - 1)
Case 8
RArr(k, d2) = RArr(k, d2) + SArr(i, d2 + 3)
Case 9
RArr(k, 9) = SArr(i, 10)
Case 10, 11
RArr(k, d2) = RArr(k, d2) + SArr(i, d2 + 3)
Case 14, 15
RArr(k, d2) = RArr(k, d2) + SArr(i, d2 + 1)
Case 18
Arr(k, d2) = Val(RArr(k, d2)) + Val(SArr(i, d2 + 1))
Case 19
RArr(k, d2) = RArr(k, d2) + SArr(i, d2 + 1)
Case 23 To 33thì có thể
RArr(k, d2) = RArr(k, d2) + SArr(i, d2)
End Select
Next d2
Thực ra, case 8 có thể gộp vào cases 10-11, và 19 có thể gộp vào 14-15. Nhưng làm theo thứ tự thì dễ kiểm soát chỗ thiếu sót hơn.

"nếu thêm 100 cột" thì có thể phải dùng hàm con hoặc lệnh GoSub. Hoặc có thể phải dùng array để map cách sử lý.

(*) suy nghĩ thử xem lý do gì thì chính đáng hơn.
 
Được, nhưng với lý do khác. Lý do "code cũng cực" không chính đáng lắm (*)

For d2 = 1 To 33
Select Case d2
Case 1 To 4
RArr(k, d2) = SArr(i, d2)
Case 5
RArr(k, d2) = SArr(i, d2+ 2)
Case 6
RArr(k, d2) = SArr(i, d2 + 3)
Case 7
RArr(k, d2) = RArr(k, d2) + SArr(i, d2 - 1)
Case 8
RArr(k, d2) = RArr(k, d2) + SArr(i, d2 + 3)
Case 9
RArr(k, 9) = SArr(i, 10)
Case 10, 11
RArr(k, d2) = RArr(k, d2) + SArr(i, d2 + 3)
Case 14, 15
RArr(k, d2) = RArr(k, d2) + SArr(i, d2 + 1)
Case 18
Arr(k, d2) = Val(RArr(k, d2)) + Val(SArr(i, d2 + 1))
Case 19
RArr(k, d2) = RArr(k, d2) + SArr(i, d2 + 1)
Case 23 To 33thì có thể
RArr(k, d2) = RArr(k, d2) + SArr(i, d2)
End Select
Next d2
Thực ra, case 8 có thể gộp vào cases 10-11, và 19 có thể gộp vào 14-15. Nhưng làm theo thứ tự thì dễ kiểm soát chỗ thiếu sót hơn.

"nếu thêm 100 cột" thì có thể phải dùng hàm con hoặc lệnh GoSub.

(*) suy nghĩ thử xem lý do gì thì chính đáng hơn.
Con cảm ơn Bác VetMini đã chỉ dẫn ạ,
Con ví dụ thôi Bác ạ, cũng là rút gọn cho code dễ nhìn hơn ạ.
Chắc chú Mỹ làm nhanh nên cũng cop cop cho nhanh ạ.
 
...Con ví dụ thôi Bác ạ, cũng là rút gọn cho code dễ nhìn hơn ạ...
Code dễ nhìn cũng như người đẹp bán hàng. Chỉ giúp bán hàng chạy hơn nhưng chả có nghĩa lý gì trong chất lượng món hàng cả. Lắm khi do mướn người đẹp mà thành tiền cao hơn.
 
Dạ, là dòng này thừa phải không chú Mỹ:
DictCount = Dict1.Count
Đọc kỹ câu hỏi: trong vòng lặp, chứ không phải trong toàn bộ thủ tục.
DictCount có vẻ dư nhưng nó lại cần cho code được rõ ràng và đọc dễ hiểu, nhất là cách đặt tên biến.
k là kết quả của 1 vòng lặp và vòng lặp đó kết thúc cách đó 1 khoảng thời gian, trong khoảng thời gian đó biết đâu có chuyện gì xảy ra và k bị mất giá trị
 
Đọc kỹ câu hỏi: trong vòng lặp, chứ không phải trong toàn bộ thủ tục.
DictCount có vẻ dư nhưng nó lại cần cho code được rõ ràng và đọc dễ hiểu, nhất là cách đặt tên biến.
k là kết quả của 1 vòng lặp và vòng lặp đó kết thúc cách đó 1 khoảng thời gian, trong khoảng thời gian đó biết đâu có chuyện gì xảy ra và k bị mất giá trị
Con cũng đã nhìn lại mấy lần trong vòng lặp thì mỗi câu lệnh đều có tính toán riêng nên con không nghĩ là dư ạ.
Chú Mỹ có gợi ý gì thêm không ạ?
 
Được, nhưng với lý do khác. Lý do "code cũng cực" không chính đáng lắm (*)
"nếu thêm 100 cột" thì có thể phải dùng hàm con hoặc lệnh GoSub. Hoặc có thể phải dùng array để map cách sử lý.
Trước khi viết trong vòng lặp tôi đã ghi ra giấy như thế này và chả thấy quy luật gì, thậm chí 31, 32, 33 còn lặp lại của 24, 25, 26. Nếu nhiều cột (100 cột) thì tôi dùng dữ liệu trong hình này tạo 1 mảng 2 cột và lặp for ngon lành. Cũng có ngoại lệ và phải dùng If hoặc case bên trong nữa. (nhất là cột 18 bị lỗi cộng text, phải dùng val)


1608103332621.png

Con cũng đã nhìn lại mấy lần trong vòng lặp thì mỗi câu lệnh đều có tính toán riêng nên con không nghĩ là dư ạ.
Chú Mỹ có gợi ý gì thêm không ạ?
Gợi ý thì còn gì mà nói nữa
 
Trước khi viết trong vòng lặp tôi đã ghi ra giấy như thế này và chả thấy quy luật gì, thậm chí 31, 32, 33 còn lặp lại của 24, 25, 26. Nếu nhiều cột (100 cột) thì tôi dùng dữ liệu trong hình này tạo 1 mảng 2 cột và lặp for ngon lành. Cũng có ngoại lệ và phải dùng If hoặc case bên trong nữa. (nhất là cột 18 bị lỗi cộng text, phải dùng val)


View attachment 251321


Gợi ý thì còn gì mà nói nữa
Vậy con đoán là thừa dòng này phải không chú Mỹ: LsxNo = SArr(i, 1), nghĩa là biến "LsxNo" cũng không cần ạ , thế lại không rõ ràng ạ.
Bài đã được tự động gộp:

À nếu cái này con hiểu rồi Bác Hiếu , gán luôn kết quả vào vòng lặp phía trên ạ
 
Làm như anh bảo:
- DictCount không biết bao nhiêu nên phải redim RArr bằng số dòng với SArr
- Trong vòng lặp chia ra 2 trường hợp exist và not exist, viết không khéo thì code dài
- Phải dự phòng trường hợp sheet chi tiết chưa được sắp xếp (câu lệnh phải tính thêm)
Tôi thì lười nên chọn cách dễ.

Vậy con đoán là thừa dòng này phải không chú Mỹ: LsxNo = SArr(i, 1), nghĩa là biến "LsxNo" cũng không cần ạ , thế lại không rõ ràng ạ.
Nếu ngay từ đầu tôi viết gộp 2 biến thành 1, 2 For thành 1, 2 mảng thành 1 thì mấy tiểu thư nhà cô đọc 1 lần có hiểu không?
Thôi nói luôn:
Các câu lệnh gán cho 6 cột đầu và cột 9 là dư, những lần sau ghi đè lên lần trước, còn những cột còn lại thì lần sau cộng dồn vào lần trước
 
Lần chỉnh sửa cuối:
Làm như anh bảo:
- DictCount không biết bao nhiêu nên phải redim RArr bằng số dòng với SArr
- Trong vòng lặp chia ra 2 trường hợp exist và not exist, viết không khéo thì code dài
- Phải dự phòng trường hợp sheet chi tiết chưa được sắp xếp (câu lệnh phải tính thêm)
Tôi thì lười nên chọn cách dễ.


Nếu ngay từ đầu tôi viết gộp 2 biến thành 1, 2 For thành 1, 2 mảng thành 1 thì mấy tiểu thư nhà cô đọc 1 lần có hiểu không?
Thôi nói luôn:
Các câu lệnh gán cho 6 cột đầu và cột 9 là dư, những lần sau ghi đè lên lần trước, còn những cột còn lại thì lần sau cộng dồn vào lần trước
Mình thường chỉ dùng If Exists không dùng Else
Mã:
Sub Tonghop()
Dim Dict1, SArr()
Dim LRw As Long, ik As Long, LsxNo As String, k As Long, sRow&
Set Dict1 = CreateObject("Scripting.Dictionary")
LRw = Sheet1.[A100000].End(xlUp).Row
SArr = Sheet1.Range("A4:AI" & LRw).Value
Application.ScreenUpdating = False
t = Timer
sRow = UBound(sArr, 1)
ReDim RArr(1 To sRow, 1 To 35)
For i = 1 To sRow
    LsxNo = CStr(sArr(i, 1))
    If Not Dict1.exists(LsxNo) Then
        k = k + 1
        Dict1.Add LsxNo, k
        RArr(k, 1) = SArr(i, 1)
        RArr(k, 2) = SArr(i, 2)
        RArr(k, 3) = SArr(i, 3)
        RArr(k, 4) = SArr(i, 4)
        RArr(k, 5) = SArr(i, 7)
        RArr(k, 6) = SArr(i, 9)
        RArr(k, 9) = SArr(i, 10)
    End If
    ik = Dict1.Item(LsxNo)
    RArr(ik, 7) = RArr(ik, 7) + SArr(i, 6)
    RArr(ik, 8) = RArr(ik, 8) + SArr(i, 11)
    RArr(ik, 10) = RArr(ik, 10) + SArr(i, 13)
    RArr(ik, 11) = RArr(ik, 11) + SArr(i, 14)
    RArr(ik, 14) = RArr(ik, 14) + SArr(i, 16)
    RArr(ik, 15) = RArr(ik, 15) + SArr(i, 17)
    RArr(ik, 18) = (RArr(ik, 18)) + Val(SArr(i, 19))
    RArr(ik, 19) = RArr(ik, 19) + SArr(i, 20)
    RArr(ik, 23) = RArr(ik, 23) + SArr(i, 23)
    RArr(ik, 24) = RArr(ik, 24) + SArr(i, 24)
    RArr(ik, 25) = RArr(ik, 25) + SArr(i, 25)
    RArr(ik, 26) = RArr(ik, 26) + SArr(i, 26)
    RArr(ik, 27) = RArr(ik, 27) + SArr(i, 27)
    RArr(ik, 28) = RArr(ik, 28) + SArr(i, 28)
    RArr(ik, 29) = RArr(ik, 29) + SArr(i, 29)
    RArr(ik, 30) = RArr(ik, 30) + SArr(i, 30)
    RArr(ik, 31) = RArr(ik, 31) + SArr(i, 31)
    RArr(ik, 32) = RArr(ik, 32) + SArr(i, 32)
    RArr(ik, 33) = RArr(ik, 33) + SArr(i, 33)
Next
Sheet3.[A5].Resize(5000, 35).ClearContents
Sheet3.[A5].Resize(k, 35).Value = RArr
Application.ScreenUpdating = True
MsgBox Timer - t & " seconds", , "ptm0412"    
End Sub
 
Web KT

Bài viết mới nhất

Back
Top Bottom