Nhờ Viết Code Tính Tổng Theo Nhiều điều Kiện! | Tự Học VBA

Menu

• Trang chủ
• Diễn đàn Bài viết mới Tìm chủ đề
• Có gì mới Bài viết mới Hoạt động mới nhất

Đăng nhập Đăng ký Có gì mới? Tìm kiếm

Tìm kiếm

Everywhere Chủ đề This forum This thread Chỉ tìm trong tiêu đề Bởi: Tìm Tìm kiếm nâng cao…

• Bài viết mới
• Tìm chủ đề

Menu Đăng nhập Đăng ký

• Cách upload ảnh lên diễn đàn

• Trang chủ
• Diễn đàn
• Kỹ thuật xử lý Excel
• Hỏi -Code Theo Yêu Cầu Có Trả Phí

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

• Thread starter mrbomst
• Ngày gửi 9/12/20

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

• 1
• 2

Tiếp 1 of 2

Đi đến trang

Tới Tiếp Last M

mrbomst

Yêu THVBA

Kính gửi mọi người trên diễn đàn. em muốn tính tổng theo điều kiện cho số lượng xuất trong kỳ bằng mã VBA. hy vọng mọi người viết giúp em với ạ! EM xin cảm ơn ạ! Em cần tính tổng theo điều kiện ở cột C và F cho tất cả các dòng xuất hiện đáp ứng đủ 2 điều kiện này. Bạn cần đăng nhập để thấy hình ảnh Bạn cần đăng nhập để thấy link Sửa lần cuối: 9/12/20 D

Deleted member 1392

Guest

Cái này bạn Sumifs là được rồi, cần gì VBA ? M

mrbomst

Yêu THVBA

mình biết dung sumif được nhưng dữ liệu của mình lên đến hơn 20.000 dòng dẫn đến tăng dung lượng file và giảm tốc độ tính toán của trang tính. nên mong được mọi người giúp.

Ngày Mới nói: Cái này bạn Sumifs là được rồi, cần gì VBA ? Nhấn để mở rộng...

D

Deleted member 1392

Guest

Gởi file lên mọi người sẽ giúp cho bạn, không có file muốn giúp bạn cũng không giúp được M

mrbomst

Yêu THVBA

Ngày Mới nói: Gởi file lên mọi người sẽ giúp cho bạn, không có file muốn giúp bạn cũng không giúp được Nhấn để mở rộng...

Em đã chỉnh sửa bài viết rồi ạ! D

Deleted member 1392

Guest

@mrbomst Cho đoạn code này vào rồi chạy thử nhé, nhớ thay đổi vùng cần chạy dữ liệu cho tương ứng với 20,000 dòng của bạn. Mã: Sub Sumifs() Dim rng As Range '//INPUT RANGE Set rng = Range("I4:I16") With rng .FormulaArray = "=SUMIFS(C[-2],C[-6],RC[-6]:R[" & .Count - 1 & "]C[-6],C[-3],RC[-3]:R[" & .Count - 1 & "]C[-3])" .Value = .Value End With End Sub M

mrbomst

Yêu THVBA

Ngày Mới nói: @mrbomst Cho đoạn code này vào rồi chạy thử nhé, nhớ thay đổi vùng cần chạy dữ liệu cho tương ứng với 20,000 dòng của bạn. Mã: Sub Sumifs() Dim rng As Range '//INPUT RANGE Set rng = Range("I4:I16") With rng .FormulaArray = "=SUMIFS(C[-2],C[-6],RC[-6]:R[" & .Count - 1 & "]C[-6],C[-3],RC[-3]:R[" & .Count - 1 & "]C[-3])" .Value = .Value End With End Sub Nhấn để mở rộng...

Làm như này thì cũng không nhanh hơn là mấy. nhờ bác có thể viết giúp em bằng vòng lặp hoặc sử dụng bằng dictionary được không ạ! B

Binana

VIP

@mrbomst Cái này có thể sử dụng Pivottable được mà. Còn VBA thì bạn nên đưa file có cấu trúc thật lên để đỡ mất công sửa. Điều nữa bạn nên demo kết quả bạn muốn như nào nữa M

mrbomst

Yêu THVBA

Binana nói: @mrbomst Cái này có thể sử dụng Pivottable được mà. Còn VBA thì bạn nên đưa file có cấu trúc thật lên để đỡ mất công sửa. Điều nữa bạn nên demo kết quả bạn muốn như nào nữa Nhấn để mở rộng...

Dạ do đây là dữ liệu để phục vu công đoạn sau nên không thể sử dụng pivot table được ạ. còn cấu trúc thật thì cũng giống file em gửi. và dữ liẹu demo em cũng đã có đăng trên đầu. em xin gửi lại ảnh kế quả sau khi tính toán xong sẽ như sau ạ! Bạn cần đăng nhập để thấy hình ảnh N

NhanSu

SMod

Thành viên BQT Sử dụng Sumifs nếu dùng vba như bạn Ngày mới sẽ nhanh hơn công thức trên sheet do công thức thường xuyên bị tính lại nhưng với 20000 dòng thì vẫn chậm. Đơn giản nhất là sử dụng cột phụ ghép 2 cột mã lại, pivot với dòng là các mã này rồi điền tổng bằng vlookup. Dùng vba với dictionary nhanh nhất nhưng mất công code. Hoặc có thể dùng power query, tốc độ chấp nhận được. M

mrbomst

Yêu THVBA

NhanSu nói: Sử dụng Sumifs nếu dùng vba như bạn Ngày mới sẽ nhanh hơn công thức trên sheet do công thức thường xuyên bị tính lại nhưng với 20000 dòng thì vẫn chậm. Đơn giản nhất là sử dụng cột phụ ghép 2 cột mã lại, pivot với dòng là các mã này rồi điền tổng bằng vlookup. Dùng vba với dictionary nhanh nhất nhưng mất công code. Hoặc có thể dùng power query, tốc độ chấp nhận được. Nhấn để mở rộng...

Dữ liệu tính của em là dữ liệu nhập liệu và tính tự động. hy vọng được mọi người giúp đỡ bằng mã vba ạ! N

NhanSu

SMod

Thành viên BQT Mã: 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 Dim Data(), Tong(), i&, k&, n&, s$ Data = Range("C4:G" & Range("C1000000").End(xlUp).Row).Value n = UBound(Data) ReDim Tong(1 To n, 1 To 1) For i = 1 To n s = Data(i, 1) & "#$" & Data(i, 4) If Not Dic.Exists(s) Then Dic.Add s, Data(i, 5) Else Dic.Item(s) = Dic.Item(s) + Data(i, 5) End If Next For i = 1 To n Tong(i, 1) = Dic.Item(Data(i, 1) & "#$" & Data(i, 4)) Next Range("I4").Resize(n) = Tong End Sub Bạn nhớ chọn Tool/Reference Microsoft Scripting runtime, nếu không chọn thì sửa xxx thành False M

mrbomst

Yêu THVBA

NhanSu nói: Mã: 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 Dim Data(), Tong(), i&, k&, n&, s$ Data = Range("C4:G" & Range("C1000000").End(xlUp).Row).Value n = UBound(Data) ReDim Tong(1 To n, 1 To 1) For i = 1 To n s = Data(i, 1) & "#$" & Data(i, 4) If Not Dic.Exists(s) Then Dic.Add s, Data(i, 5) Else Dic.Item(s) = Dic.Item(s) + Data(i, 5) End If Next For i = 1 To n Tong(i, 1) = Dic.Item(Data(i, 1) & "#$" & Data(i, 4)) Next Range("I4").Resize(n) = Tong End Sub Bạn nhớ chọn Tool/Reference Microsoft Scripting runtime, nếu không chọn thì sửa xxx thành False Nhấn để mở rộng...

EM xin cảm ơn ạ! M

mrbomst

Yêu THVBA

NhanSu nói: Mã: 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 Dim Data(), Tong(), i&, k&, n&, s$ Data = Range("C4:G" & Range("C1000000").End(xlUp).Row).Value n = UBound(Data) ReDim Tong(1 To n, 1 To 1) For i = 1 To n s = Data(i, 1) & "#$" & Data(i, 4) If Not Dic.Exists(s) Then Dic.Add s, Data(i, 5) Else Dic.Item(s) = Dic.Item(s) + Data(i, 5) End If Next For i = 1 To n Tong(i, 1) = Dic.Item(Data(i, 1) & "#$" & Data(i, 4)) Next Range("I4").Resize(n) = Tong End Sub Bạn nhớ chọn Tool/Reference Microsoft Scripting runtime, nếu không chọn thì sửa xxx thành False Nhấn để mở rộng...

Cho em hỏi là nếu như điều kiện thứ 2 chuyển thành hàng ngang thì ta có thể sửa lại mã này như nào ạ. mong bác hướng dẫn với ạ! Bạn cần đăng nhập để thấy hình ảnh dữ liệu vẫn giữ nguyên. chỉ thay đổi cách hiển thị điều kiện và hiển thị kết quả ạ! V

vanthanhVBA

VIP

Tại sao ngay từ đầu bạn không nói luôn muốn output được biểu diễn như thế nào, bây giờ lại thay đổi hiển thị kết quả là sao? Cách làm việc kiểu gì kỳ vậy. Bạn tự làm đi. M

mrbomst

Yêu THVBA

vanthanhVBA nói: Tại sao ngay từ đầu bạn không nói luôn muốn output được biểu diễn như thế nào, bây giờ lại thay đổi hiển thị kết quả là sao? Cách làm việc kiểu gì kỳ vậy. Bạn tự làm đi. Nhấn để mở rộng...

dạ. lúc đầu mục đích của em là tính như vậy nhưng giờ còn một bảng tính khác dữ liệu không giống bảng tính cũ nên em muốn nhờ mọi người hướng dẫn để em có thể sửa chứ không phải dữ liệu ban đầu em đưa lên không đúng mục đích, mong bạn thông cảm. còn mình lên diễn đàn là để học hỏi mọi người. trao đổi để có thể tiến bộ hơn. bạn có thể giúp hoặc không giúp. nhưng đừng nói chuyển cái kiểu như vậy. thân ái! C

chisinhvnn

Yêu THVBA

mrbomst nói: dạ. lúc đầu mục đích của em là tính như vậy nhưng giờ còn một bảng tính khác dữ liệu không giống bảng tính cũ nên em muốn nhờ mọi người hướng dẫn để em có thể sửa chứ không phải dữ liệu ban đầu em đưa lên không đúng mục đích, mong bạn thông cảm. còn mình lên diễn đàn là để học hỏi mọi người. trao đổi để có thể tiến bộ hơn. bạn có thể giúp hoặc không giúp. nhưng đừng nói chuyển cái kiểu như vậy. thân ái! Nhấn để mở rộng...

bạn xem lại vùng đk 2 bao nhiều điều kiện, không mấy bạn code xong rồi đưa vô thực tế lại không đc Sửa lần cuối: 11/12/20 D

Deleted member 1392

Guest

@mrbomst Cho code này vào chạy thử xem. Mã: Sub ThV() Dim arrIn, arrDK, arrOut As Variant Dim i, j, h, numS As Long '//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(arrDK, 1) To UBound(arrDK, 1) For j = numS To UBound(arrDK, 2) For h = LBound(arrIn, 1) To UBound(arrIn, 1) If arrIn(h, 1) = arrDK(i, 1) And arrIn(h, 4) = arrDK(i, j) Then arrOut(i, j - numS + 1) = arrOut(i, j - numS + 1) + CDbl(arrIn(h, 5)) End If Next h Next j Next i '//OUTPUT Range("T4:V" & Range("M1000000").End(xlUp).Row).Value = arrOut End Sub M

mrbomst

Yêu THVBA

Ngày Mới nói: @mrbomst Cho code này vào chạy thử xem. Mã: Sub ThV() Dim arrIn, arrDK, arrOut As Variant Dim i, j, h, numS As Long '//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(arrDK, 1) To UBound(arrDK, 1) For j = numS To UBound(arrDK, 2) For h = LBound(arrIn, 1) To UBound(arrIn, 1) If arrIn(h, 1) = arrDK(i, 1) And arrIn(h, 4) = arrDK(i, j) Then arrOut(i, j - numS + 1) = arrOut(i, j - numS + 1) + CDbl(arrIn(h, 5)) End If Next h Next j Next i '//OUTPUT Range("T4:V" & Range("M1000000").End(xlUp).Row).Value = arrOut End Sub Nhấn để mở rộng...

Em cảm ơn bác Ngày Mới nhiệt tình giúp đỡ em ạ. mã này đã tính đúng được theo nhu cầu của em chỉ có điều với dữ liệu 20000 dòng và hơn 2000 mã thì vba load hơi lâu. chắc cũng không thể đòi hỏi thêm được với các bố trí dữ liệu và số liệu lớn như vậy. rất cảm ơn bác ạ! D

Deleted member 1392

Guest

@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

• 1
• 2

Tiếp 1 of 2

Đi đến trang

Tới Tiếp Last Trạng thái Không mở trả lời sau này. Chia sẻ: Facebook Twitter WhatsApp Email Link

• Trang chủ
• Diễn đàn
• Kỹ thuật xử lý Excel
• Hỏi -Code Theo Yêu Cầu Có Trả Phí

Top