Code tính tổng nhiều điều kiện cách cột trống

Liên hệ QC
Anhduong2015

Anhduong2015

Thành viên chính thức
Tham gia
29/7/21
Bài viết
53
Được thích
12
Xin chào anh/chị
- Trước khi đăng bài em xin phép trình bày là đã tìm các bài tương tự trên diễn đàn và có tham khảo, có áp dụng nhưng do có vài điểm khác biệt nên em làm mãi không được và đi vào bế tắc vì thế nếu có trùng chủ đề mong các anh/chị rộng lượng bỏ qua giùm.
- Bài này do đặc thù công việc của kho em đang làm nên không thiết kế theo cấu trúc chuẩn để thực hiện PivotTable được, hiện tại phần tổng số lượng nhập xuất theo ngày và theo tên sản phẩm em đang dùng công thức cơ bản Sumifs tuy nhiên có nhiều Sheet và nhiều mặt hàng nên máy tính em xử lý rất chậm khi thao tác nên em mới mài mò nghĩ đến VBA.
- Do trình độ mới bập bẽ học lõm về Mảng và Dictionary nên với yêu cầu mới kết hợp nhiều điều kiện và có cột trống không liên tiếp nên em quắn hết cả não và thật sự bó tay.
- Nhờ anh/chị giúp đỡ đoạn code để lấy giá trị tổng theo điều kiện và điền vào từ ô F12 sang phải và xuống dưới của Sheet NVL_CHINH. Sub em đang viết là ở Module s3_nvlchinh tên Sub s3_tinhtong
Rất mong nhận được sự giúp đỡ của các anh/chị cao nhân, tiền bối, hậu bối.
Xin chân thành cám ơn diễn đàn.

Untitled.png
 

File đính kèm

  • Help Code Sumifs.xlsb
    177.2 KB · Đọc: 24
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Anhduong2015 đã viết:
Cám ơn anh quả thật bối rối qua nên em viết thiếu, em có bổ sung lại ở bài #1 hàng tô đỏ ạ.
Nhấp chuột vào đây để mở rộng...
Thử code này
Mã: 
Sub s3_tinhtong()
    Application.ScreenUpdating = False
        Dim Dic As New Scripting.Dictionary
        Dim arr_s2(), Res(), sArr()
        Dim lr2&, lr3&, lc3&, i&, j&, k&
        With Sheet2
            .AutoFilterMode = False
            lr2 = .Range("H" & Rows.Count).End(xlUp).Row
            arr_s2 = .Range("F9:M" & lr2).Value
        End With
        With Sheet3
            .AutoFilterMode = False
            lr3 = .Range("E" & Rows.Count).End(xlUp).Row
            lc3 = .Cells(10, Columns.Count).End(xlToLeft).Column + 1
            sArr = .Range("E10").Resize(lr3 - 9, lc3 - 4).Value
            ReDim Res(1 To UBound(sArr) - 2, 1 To UBound(sArr, 2) - 1)
            For i = 3 To UBound(sArr)
                Dic.Item(sArr(i, 1)) = i - 2
            Next
            For j = 2 To UBound(sArr, 2)
                Dic.Item(sArr(1, j)) = j - 1
            Next
            For i = 1 To UBound(arr_s2)
                If Dic.Exists(arr_s2(i, 1)) = True And Dic.Exists(arr_s2(i, 3)) = True Then
                    Res(Dic.Item(arr_s2(i, 1)), Dic.Item(arr_s2(i, 3))) = arr_s2(i, 7)
                    Res(Dic.Item(arr_s2(i, 1)), Dic.Item(arr_s2(i, 3)) + 1) = arr_s2(i, 8)
                End If
            Next
            .Range("F12").Resize(UBound(Res), UBound(Res, 2)).Value = Res
        End With
        
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
BuiQuangThuan đã viết:
Thử code này
Mã: 
Sub s3_tinhtong()
    Application.ScreenUpdating = False
        Dim Dic As New Scripting.Dictionary
        Dim arr_s2(), Res(), sArr()
        Dim lr2&, lr3&, lc3&, i&, j&, k&
        With Sheet2
            .AutoFilterMode = False
            lr2 = .Range("H" & Rows.Count).End(xlUp).Row
            arr_s2 = .Range("F9:M" & lr2).Value
        End With
        With Sheet3
            .AutoFilterMode = False
            lr3 = .Range("E" & Rows.Count).End(xlUp).Row
            lc3 = .Cells(10, Columns.Count).End(xlToLeft).Column + 1
            sArr = .Range("E10").Resize(lr3 - 9, lc3 - 4).Value
            ReDim Res(1 To UBound(sArr) - 2, 1 To UBound(sArr, 2) - 1)
            For i = 3 To UBound(sArr)
                Dic.Item(sArr(i, 1)) = i - 2
            Next
            For j = 2 To UBound(sArr, 2)
                Dic.Item(sArr(1, j)) = j - 1
            Next
            For i = 1 To UBound(arr_s2)
                If Dic.Exists(arr_s2(i, 1)) = True And Dic.Exists(arr_s2(i, 3)) = True Then
                    Res(Dic.Item(arr_s2(i, 1)), Dic.Item(arr_s2(i, 3))) = arr_s2(i, 7)
                    Res(Dic.Item(arr_s2(i, 1)), Dic.Item(arr_s2(i, 3)) + 1) = arr_s2(i, 8)
                End If
            Next
            .Range("F12").Resize(UBound(Res), UBound(Res, 2)).Value = Res
        End With
       
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Quá đẳng cấp và tuyệt vời !!! em 1000 lần cảm ơn anh nhé.
Sao phức tạp vậy mà anh cũng nghĩ ra được vậy? Anh có đào tạo không em xin đăng ký học ạ vì có đáp án rồi mà em dò lại từng câu lệnh vẫn chưa hiểu kiểu gán vòng qua vòng lại xong đập phát ra kết quả. Quá đỉnh.
Một lần nữa xin cám ơn và chúc anh nhiều sức khỏe ạ.
 
Upvote 0
Anhduong2015 đã viết:
Quá đẳng cấp và tuyệt vời !!! em 1000 lần cảm ơn anh nhé.
Sao phức tạp vậy mà anh cũng nghĩ ra được vậy? Anh có đào tạo không em xin đăng ký học ạ vì có đáp án rồi mà em dò lại từng câu lệnh vẫn chưa hiểu kiểu gán vòng qua vòng lại xong đập phát ra kết quả. Quá đỉnh.
Một lần nữa xin cám ơn và chúc anh nhiều sức khỏe ạ.
Nhấp chuột vào đây để mở rộng...
Khiếp. Gì mà bạn nói quá lên thế. Bạn hiểu được nó vận hành sao là sẽ biết được mà
 
Upvote 0
BuiQuangThuan đã viết:
Thử code này
Mã: 
Sub s3_tinhtong()
    Application.ScreenUpdating = False
        Dim Dic As New Scripting.Dictionary
        Dim arr_s2(), Res(), sArr()
        Dim lr2&, lr3&, lc3&, i&, j&, k&
        With Sheet2
            .AutoFilterMode = False
            lr2 = .Range("H" & Rows.Count).End(xlUp).Row
            arr_s2 = .Range("F9:M" & lr2).Value
        End With
        With Sheet3
            .AutoFilterMode = False
            lr3 = .Range("E" & Rows.Count).End(xlUp).Row
            lc3 = .Cells(10, Columns.Count).End(xlToLeft).Column + 1
            sArr = .Range("E10").Resize(lr3 - 9, lc3 - 4).Value
            ReDim Res(1 To UBound(sArr) - 2, 1 To UBound(sArr, 2) - 1)
            For i = 3 To UBound(sArr)
                Dic.Item(sArr(i, 1)) = i - 2
            Next
            For j = 2 To UBound(sArr, 2)
                Dic.Item(sArr(1, j)) = j - 1
            Next
            For i = 1 To UBound(arr_s2)
                If Dic.Exists(arr_s2(i, 1)) = True And Dic.Exists(arr_s2(i, 3)) = True Then
                    Res(Dic.Item(arr_s2(i, 1)), Dic.Item(arr_s2(i, 3))) = arr_s2(i, 7)
                    Res(Dic.Item(arr_s2(i, 1)), Dic.Item(arr_s2(i, 3)) + 1) = arr_s2(i, 8)
                End If
            Next
            .Range("F12").Resize(UBound(Res), UBound(Res, 2)).Value = Res
        End With
      
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Bữa nào đó cũng tập viết dic theo kiểu này. Tôi quen viết kiểu dic.Add Key, Item. Viết lạ cái là ngợ, chậm tiến trình liền.
Bài đã được tự động gộp:

Cười gì cha nội? @!>><
 
Lần chỉnh sửa cuối:
Upvote 0
Maika8008 đã viết:
Bữa nào đó cũng tập viết dic theo kiểu này. Tôi quen viết kiểu dic.Add Key, Item. Viết lạ cái là ngợ, chậm tiến trình liền.
Nhấp chuột vào đây để mở rộng...
Em cũng học của mấy anh chị thầy cô trên này cả. Em thì lại ngược ngược anh. Nếu Dic.add key ấy. Tự nhiên em thấy không khai thác hết Dic được. Thực ra bài trên nếu em đọc lại. Em vẫn thấy nó sẽ sai kết quả nếu như có sự lặp lại ở bảng dữ liệu
Có lẽ nên sửa lại 1 chút như này ạ
Mã: 
Sub s3_tinhtong()
    Application.ScreenUpdating = False
        Dim Dic As New Scripting.Dictionary
        Dim arr_s2(), Res(), sArr()
        Dim lr2&, lr3&, lc3&, i&, j&, k&
        With Sheet2
            .AutoFilterMode = False
            lr2 = .Range("H" & Rows.Count).End(xlUp).Row
            arr_s2 = .Range("F9:M" & lr2).Value
        End With
        With Sheet3
            .AutoFilterMode = False
            lr3 = .Range("E" & Rows.Count).End(xlUp).Row
            lc3 = .Cells(10, Columns.Count).End(xlToLeft).Column + 1
            sArr = .Range("E10").Resize(lr3 - 9, lc3 - 4).Value
            ReDim Res(1 To UBound(sArr) - 2, 1 To UBound(sArr, 2) - 1)
            For i = 3 To UBound(sArr)
                Dic.Item(sArr(i, 1)) = i - 2
            Next
            For j = 2 To UBound(sArr, 2) Step 2
                If Dic.Exists(sArr(1, j)) = False Then
                    Dic.Item(sArr(1, j)) = j - 1
                End If
            Next
            For i = 1 To UBound(arr_s2)
                If Dic.Exists(arr_s2(i, 1)) = True And Dic.Exists(arr_s2(i, 3)) = True Then
                    Res(Dic.Item(arr_s2(i, 1)), Dic.Item(arr_s2(i, 3))) = Res(Dic.Item(arr_s2(i, 1)), Dic.Item(arr_s2(i, 3))) + arr_s2(i, 7)
                    Res(Dic.Item(arr_s2(i, 1)), Dic.Item(arr_s2(i, 3)) + 1) = Res(Dic.Item(arr_s2(i, 1)), Dic.Item(arr_s2(i, 3)) + 1) + arr_s2(i, 8)
                End If
            Next
            .Range("F12").Resize(UBound(Res), UBound(Res, 2)).Value = Res
        End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
BuiQuangThuan đã viết:
Em cũng học của mấy anh chị thầy cô trên này cả. Em thì lại ngược ngược anh. Nếu Dic.add key ấy. Tự nhiên em thấy không khai thác hết Dic được.
Nhấp chuột vào đây để mở rộng...
Maika8008 đã viết:
Tôi quen viết kiểu dic.Add Key, Item. Viết lạ cái là ngợ, chậm tiến trình liền.
Nhấp chuột vào đây để mở rộng...

Thêm key/ thay đổi item vào/ trong Dictionary là công việc rất nặng nhọc, nên càng hạn chế số lần thực hiện hành động đó càng tốt.

Việc dùng Dic.Item(key) = item lặp lại nhiều lần việc thay đổi item nếu key trùng, và mặc nhiên chỉ lấy item ở lần thực hiện cuối.

(Trông có vẻ 'nguy hiểm' nhưng hiệu quả không cao).
----
Học chọn lọc cái hay, cái tốt thôi. Không phải cái gì mới lạ cũng tốt.
 
Upvote 0
befaint đã viết:
Thêm key/ thay đổi item vào/ trong Dictionary là công việc rất nặng nhọc, nên càng hạn chế số lần thực hiện hành động đó càng tốt.

Việc dùng Dic.Item(key) = item lặp lại nhiều lần việc thay đổi item, và mặc nhiên chỉ lấy item ở lần thực hiện cuối.

(Trông có vẻ 'nguy hiểm' nhưng hiệu quả không cao).
----
Học chọn lọc cái hay, cái tốt thôi. Không phải cái gì mới lạ cũng tốt.
Nhấp chuột vào đây để mở rộng...
Chưa hiểu lắm befaint à. Tôi là người thực hành rồi từ từ tiếp cận lý thuyết chứ tôi kém lý thuyết lắm lận.
 
Upvote 0
befaint đã viết:
Thêm key/ thay đổi item vào/ trong Dictionary là công việc rất nặng nhọc, nên càng hạn chế số lần thực hiện hành động đó càng tốt.

Việc dùng Dic.Item(key) = item lặp lại nhiều lần việc thay đổi item nếu key trùng, và mặc nhiên chỉ lấy item ở lần thực hiện cuối.

(Trông có vẻ 'nguy hiểm' nhưng hiệu quả không cao).
----
Học chọn lọc cái hay, cái tốt thôi. Không phải cái gì mới lạ cũng tốt.
Nhấp chuột vào đây để mở rộng...
Lười viết thêm mấy dòng code kiểm tra thì viết theo cách Dic.item(key)=i.
Nhattanktnn đã viết:
Nếu add key nhiều, tức số lượng key không trùng là lớn, với dữ liệu lớn sẽ rất chậm chạp
Nhấp chuột vào đây để mở rộng...
Không phải ý này.Theo tôi đoán là nó lấy item cuối cùng nếu trùng key.Nếu dữ liệu lớn thì cái gì nó chẳng chậm.
Còn ý đầu là mỗi lần key nó trùng nó sẽ phải thay lại item mới.Nhưng nếu mà muốn lấy dòng cuối cùng thì vẫn phải kiểm tra và thay đổi.Nếu không thì phải chạy vòng lặp ngược lại.
 
Upvote 0
snow25 đã viết:
Không phải ý này.Theo tôi đoán là nó lấy item cuối cùng nếu trùng key.Nếu dữ liệu lớn thì cái gì nó chẳng chậm.
Nhấp chuột vào đây để mở rộng...
Tất nhiên dữ liệu lớn thì cái gì nó cũng chậm, nhưng tôi đang nói về vấn đề "Thêm key/ thay đổi item vào/ trong Dictionary là công việc rất nặng nhọc". Ý bác ấy nói nặng nhọc tức là phải chậm chạp mới gọi là nặng nhọc, file đính kèm là test một cái là chỉ add key,còn 1 cái là chỉ ghi vào mảng với 1triệu dòng, tuy có thể so sánh hơi khập khiễng nhưng để nhận thấy add key số lượng lớn nặng nhọc thế nào
 

File đính kèm

  • thu add dic.xlsm
    488.3 KB · Đọc: 8
Upvote 0
Nhattanktnn đã viết:
Tất nhiên dữ liệu lớn thì cái gì nó cũng chậm, nhưng tôi đang nói về vấn đề "Thêm key/ thay đổi item vào/ trong Dictionary là công việc rất nặng nhọc". Ý bác ấy nói nặng nhọc tức là phải chậm chạp mới gọi là nặng nhọc, file đính kèm là test một cái là chỉ add key,còn 1 cái là chỉ ghi vào mảng với 1triệu dòng, tuy có thể so sánh hơi khập khiễng nhưng để nhận thấy add key số lượng lớn nặng nhọc thế nào
Nhấp chuột vào đây để mở rộng...
Bác befaint nói mập mờ quá làm tôi chưa hiểu ở chỗ dic.Add Key, Item có khác gì về tốc độ hay chiếm Ram hơn so với dic.Item(Key) = item ?
 
Upvote 0
Maika8008 đã viết:
Bác befaint nói mập mờ quá làm tôi chưa hiểu ở chỗ dic.Add Key, Item có khác gì về tốc độ hay chiếm Ram hơn so với dic.Item(Key) = item ?
Nhấp chuột vào đây để mở rộng...
Anh ấy có nói so sánh dic.add key với dic.item(key) đâu bác. Ý chỉ nói 2 công việc đó là nặng nhọc, nếu không cần thiết thì nên hạn chế.
Chỗ dic.item(key) ý nói nếu key đã tồn tại, nó sẽ thay đổi item của nó theo cái cuối cùng
 
Upvote 0
Nhattanktnn đã viết:
Tất nhiên dữ liệu lớn thì cái gì nó cũng chậm, nhưng tôi đang nói về vấn đề "Thêm key/ thay đổi item vào/ trong Dictionary là công việc rất nặng nhọc". Ý bác ấy nói nặng nhọc tức là phải chậm chạp mới gọi là nặng nhọc, file đính kèm là test một cái là chỉ add key,còn 1 cái là chỉ ghi vào mảng với 1triệu dòng, tuy có thể so sánh hơi khập khiễng nhưng để nhận thấy add key số lượng lớn nặng nhọc thế nào
Nhấp chuột vào đây để mở rộng...
Nếu mà có phương án không cần dùng Dictionary mà tốc độ vẫn được nhanh thì không cần.Ở đây đã dùng Dictionary là để tối ưu tốc độ sử lý tránh phải lặp lại nhiều lần mà.Chứ đã dùng đến thư viện thì nó sẽ chậm hơn là điều đương nhiên.Mà Dictionary vẫn còn nhanh hơn System.Collections.ArrayList.Nên cứ dùng đi không sao đâu.
Maika8008 đã viết:
Bác befaint nói mập mờ quá làm tôi chưa hiểu ở chỗ dic.Add Key, Item có khác gì về tốc độ hay chiếm Ram hơn so với dic.Item(Key) = item ?
Nhấp chuột vào đây để mở rộng...
Tôi đoán thì nó vẫn thế.Bạn dùng dic.add key,item thì phải kiểm tra xem key có tồn tại trong dictionary không rồi mới add được.Còn câu lệnh dic.item(key)=item thì nó tự kiểm tra key xem có trong dic không nếu chưa có nó tự add thêm vào và ghi nhận Item đó.Còn có rồi thì nó không add nữa mà chỉ thay đổi item thôi.
 
Upvote 0
Nhattanktnn đã viết:
Anh ấy có nói so sánh dic.add key với dic.item(key) đâu bác. Ý chỉ nói 2 công việc đó là nặng nhọc, nếu không cần thiết thì nên hạn chế.
Chỗ dic.item(key) ý nói nếu key đã tồn tại, nó sẽ thay đổi item của nó theo cái cuối cùng
Nhấp chuột vào đây để mở rộng...
À ra vậy. Chừ tôi hiểu rồi.

Vì trước đó tôi nói là "cũng tập viết dic theo kiểu này. Tôi quen viết kiểu dic.Add Key, Item" (*)
nên khi đọc bài #9 tôi cứ tưởng là 2 kiểu đó sẽ có khác nhau về tốc độ xử lý.

(*) viết dic theo kiểu này là theo kiểu dic.item(key)
 
Upvote 0
Em đang mong ngóng anh befaint khai sáng thực tế qua một ví dụ để giảm bớt sự nặng nhọc. :)
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

Toanke063
  • Question
Xin hỏi code vba chuyển 1 file pdf bất kì thành ảnh
Trả lời
4
Đọc
52
Toanke063
Toanke063
Bebooby
Tách mã sản phẩm trong chuỗi thông tin
Trả lời
0
Đọc
1
Bebooby
Bebooby
T
Xin trợ giúp code về dò tìm dữ liệu
Trả lời
2
Đọc
113
THU UYEN317
T
thlpro
Truy Vấn Công thức từ Sheet này Qua Sheet Khác
Trả lời
8
Đọc
150
thlpro
thlpro
N
  • Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
3
Đọc
102
huhumalu
H
S
Lý do công thức bị mờ tại ô Function
    • Cười
Trả lời
2
Đọc
64
sakurasumo
S
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
5
Đọc
630
GPE-Trợ Lý
GPE-Trợ Lý
N
  • Question
Làm ơn viết giùm mình macro làm tròn giá trị ạ
    • Cười
Trả lời
14
Đọc
122
ptm0412
ptm0412
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
8 9 10
Trả lời
191
Đọc
10K
ongke0711
ongke0711
CNKyNguyen
Giảm dung lượng của file excel
    • Cảm ơn
    • Cười
    • Thích
Trả lời
2
Đọc
235
CNKyNguyen
CNKyNguyen
hunganh.nguyen
Xin giúp code tách dòng tổng thành những dòng chi tiết với giá trị là 1
Trả lời
9
Đọc
407
vostro 1500
vostro 1500
P
Sự cố về hàm SUMIF
Trả lời
8
Đọc
234
yeudoi
yeudoi
OverAC
Thông báo nội dung xấu và bài viết vi phạm nội quy.
19 20 21
Trả lời
416
Đọc
41K
vanle33
vanle33
S
Chuyển định dạng thời gian từ sa/ch sang AM/PM
Trả lời
2
Đọc
74
Silklynk
S
B
Sắp xếp lịch trực
5 6 7
Trả lời
130
Đọc
86K
TTVAN28
TTVAN28
N
Giúp em hàm Aggregate không chạy được trên Google sheet ah
Trả lời
4
Đọc
143
nguyenthieny
N
hoaithanh9480
Nhờ giúp đỡ về kiểm phiếu bầu
Trả lời
4
Đọc
105
hoaithanh9480
hoaithanh9480
B
Nhờ anh/chị giúp em tìm hàm cho công thức tính lương
Trả lời
2
Đọc
138
hoangtuaotrang_hp_vn
H
SA_DQ
Phẩu thuật Nụ cười lần 3 tại Huế.
    • Thích
    • Yêu thích
Trả lời
1
Đọc
101
HUONGHCKT
H
K
  • Question
Sử dụng Power Query để xử lý nhật ký chung nhiều nợ nhiều có
    • Cười
Trả lời
14
Đọc
303
viethung78
V
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom