Ứng dụng hàm SUMIFS trong VBA

Liên hệ QC
huunguyenfi

huunguyenfi

Thành viên mới
Tham gia
10/1/12
Bài viết
25
Được thích
5
Giới tính
Nam
Xin chào Các Anh Chị ,

Thay vì sử dụng hàm Sumifs trực tiếp trên excel nhưng vì dữ liệu quá lớn nên mình muốn học cách chạy hàm này trong VBA . Mình lần mò làm theo trên net chỉ nhưng cả ngày vẫn chưa chạy được . Anh chị nào biết làm ơn xem qua file đính kèm và hướng đãn giúp mình với ạh . Xin cám ơn nhiều .
 

File đính kèm

  • sumifs vba.xlsm
    34.4 KB · Đọc: 65
Sắp xếp theo thời gian sắp xếp theo bầu chọn
huunguyenfi đã viết:
Xin chào Các Anh Chị ,

Thay vì sử dụng hàm Sumifs trực tiếp trên excel nhưng vì dữ liệu quá lớn nên mình muốn học cách chạy hàm này trong VBA . Mình lần mò làm theo trên net chỉ nhưng cả ngày vẫn chưa chạy được . Anh chị nào biết làm ơn xem qua file đính kèm và hướng đãn giúp mình với ạh . Xin cám ơn nhiều .
Nhấp chuột vào đây để mở rộng...
Đã dùng vba quên hàm excel đi.
 
Upvote 0
huunguyenfi đã viết:
Xin chào Các Anh Chị ,

Thay vì sử dụng hàm Sumifs trực tiếp trên excel nhưng vì dữ liệu quá lớn nên mình muốn học cách chạy hàm này trong VBA . Mình lần mò làm theo trên net chỉ nhưng cả ngày vẫn chưa chạy được . Anh chị nào biết làm ơn xem qua file đính kèm và hướng đãn giúp mình với ạh . Xin cám ơn nhiều .
Nhấp chuột vào đây để mở rộng...
mình đóng góp 1 số ý kiến cho bạn:
1. Khi đưa dữ liệu lên để nhờ người khác viết Code thì cố gắng đưa dữ liệu gần đúng với file của bạn đang dùng để tránh trường hợp khi người khác viết Code xong, bạn đưa vào file của bạn không chạy được lại kêu người khác sửa lại theo bài của bạn, như thế sẽ rất mất thời gian của đôi bên.
2. Dữ liệu đưa lên phải đúng định dạng, bạn kiểm tra lại ô B1, Q2:Q4, Q6:Q9. Đây không phải là định dạng ngày tháng mà là định dạng văn bản. bạn kiểm tra xem nếu viết bằng công thức xem có ra kết quả không?
 
Upvote 0
anhtuan2939 đã viết:
mình đóng góp 1 số ý kiến cho bạn:
1. Khi đưa dữ liệu lên để nhờ người khác viết Code thì cố gắng đưa dữ liệu gần đúng với file của bạn đang dùng để tránh trường hợp khi người khác viết Code xong, bạn đưa vào file của bạn không chạy được lại kêu người khác sửa lại theo bài của bạn, như thế sẽ rất mất thời gian của đôi bên.
2. Dữ liệu đưa lên phải đúng định dạng, bạn kiểm tra lại ô B1, Q2:Q4, Q6:Q9. Đây không phải là định dạng ngày tháng mà là định dạng văn bản. bạn kiểm tra xem nếu viết bằng công thức xem có ra kết quả không?
Nhấp chuột vào đây để mở rộng...
Cám ơn phản hồi của bạn . File mình đưa lên đúng là gần đúng với file gốc , chỉ là mình cắt bắt dữ liệu lại thôi . Mình có dùng sumifs từ ô B2:M7 và công thức hoạt động ạh .
 
Upvote 0
huunguyenfi đã viết:
Mình có dùng sumifs từ ô B2:M7 và công thức hoạt động ạh
Nhấp chuột vào đây để mở rộng...
Công thức bạn hoạt động vì định dạng ngày tháng ở cột Q và ở hàng 1 sai giống nhau nên mới có kết quả. bạn kiểm tra lại nhé. Ngoài ra nếu bạn tổng hợp thì dữ liệu ở cột A không nên trùng nhau.
Bài đã được tự động gộp:

anhtuan2939 đã viết:
Công thức bạn hoạt động vì định dạng ngày tháng ở cột Q và ở hàng 1 sai giống nhau nên mới có kết quả. bạn kiểm tra lại nhé. Ngoài ra nếu bạn tổng hợp thì dữ liệu ở cột A không nên trùng nhau.
Nhấp chuột vào đây để mở rộng...
Sau khi bạn sửa lại định dạng thì dùng thử code này nhé:

Mã: 
Sub sumifs()
    Dim dic As Object, sArr(), dArr()
    Dim i As Long, j As Long, lr As Long, Row As Long, Col As Long, R1 As Long, C1 As Long
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheet1
            lr = .Range("A" & Rows.Count).End(xlUp).Row
        sArr = .Range("A2:M" & lr).Value
        R1 = UBound(sArr, 1)
        C1 = UBound(sArr, 2)
        ReDim dArr(1 To R1, 1 To C1)
        For i = 1 To R1
            dic.Item(sArr(i, 1)) = i
        Next i
        
            lr = .Range("P" & Rows.Count).End(xlUp).Row
        sArr = .Range("P2:R" & lr).Value
        For i = 1 To UBound(sArr)
            If dic.Exists(sArr(i, 1)) Then
                Row = dic.Item(sArr(i, 1))
                For Col = 1 To C1
                    If sArr(i, 2) = Cells(1, Col).Value Then dArr(Row, Col - 1) = dArr(Row, Col - 1) + sArr(i, 3)
                Next Col
            End If
        Next i
            .Range("B2").Resize(R1, C1).Value = dArr
    End With
    Set dic = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
anhtuan2939 đã viết:
Công thức bạn hoạt động vì định dạng ngày tháng ở cột Q và ở hàng 1 sai giống nhau nên mới có kết quả. bạn kiểm tra lại nhé. Ngoài ra nếu bạn tổng hợp thì dữ liệu ở cột A không nên trùng nhau.
Bài đã được tự động gộp:


Sau khi bạn sửa lại định dạng thì dùng thử code này nhé:

Mã: 
Sub sumifs()
    Dim dic As Object, sArr(), dArr()
    Dim i As Long, j As Long, lr As Long, Row As Long, Col As Long, R1 As Long, C1 As Long
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheet1
            lr = .Range("A" & Rows.Count).End(xlUp).Row
        sArr = .Range("A2:M" & lr).Value
        R1 = UBound(sArr, 1)
        C1 = UBound(sArr, 2)
        ReDim dArr(1 To R1, 1 To C1)
        For i = 1 To R1
            dic.Item(sArr(i, 1)) = i
        Next i
       
            lr = .Range("P" & Rows.Count).End(xlUp).Row
        sArr = .Range("P2:R" & lr).Value
        For i = 1 To UBound(sArr)
            If dic.Exists(sArr(i, 1)) Then
                Row = dic.Item(sArr(i, 1))
                For Col = 1 To C1
                    If sArr(i, 2) = Cells(1, Col).Value Then dArr(Row, Col - 1) = dArr(Row, Col - 1) + sArr(i, 3)
                Next Col
            End If
        Next i
            .Range("B2").Resize(R1, C1).Value = dArr
    End With
    Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn đã quan tâm . Mình sẽ chỉnh lại . Trùi ui không ngờ cái code nó dài đến vậy .Hèn chi code mình học lóm trên net chẳng đi về đâu .
 
  • Yêu thích
Reactions: th7
Upvote 0
huunguyenfi đã viết:
Cám ơn bạn đã quan tâm . Mình sẽ chỉnh lại . Trùi ui không ngờ cái code nó dài đến vậy .Hèn chi code mình học lóm trên net chẳng đi về đâu .
Nhấp chuột vào đây để mở rộng...
Mình cũng mới học nên viết dài vậy. Các thầy viết còn ngắn hơn ấy
 
Upvote 0
anhtuan2939 đã viết:
Công thức bạn hoạt động vì định dạng ngày tháng ở cột Q và ở hàng 1 sai giống nhau nên mới có kết quả. bạn kiểm tra lại nhé. Ngoài ra nếu bạn tổng hợp thì dữ liệu ở cột A không nên trùng nhau.
Bài đã được tự động gộp:


Sau khi bạn sửa lại định dạng thì dùng thử code này nhé:

Mã: 
Sub sumifs()
    Dim dic As Object, sArr(), dArr()
    Dim i As Long, j As Long, lr As Long, Row As Long, Col As Long, R1 As Long, C1 As Long
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheet1
            lr = .Range("A" & Rows.Count).End(xlUp).Row
        sArr = .Range("A2:M" & lr).Value
        R1 = UBound(sArr, 1)
        C1 = UBound(sArr, 2)
        ReDim dArr(1 To R1, 1 To C1)
        For i = 1 To R1
            dic.Item(sArr(i, 1)) = i
        Next i
       
            lr = .Range("P" & Rows.Count).End(xlUp).Row
        sArr = .Range("P2:R" & lr).Value
        For i = 1 To UBound(sArr)
            If dic.Exists(sArr(i, 1)) Then
                Row = dic.Item(sArr(i, 1))
                For Col = 1 To C1
                    If sArr(i, 2) = Cells(1, Col).Value Then dArr(Row, Col - 1) = dArr(Row, Col - 1) + sArr(i, 3)
                Next Col
            End If
        Next i
            .Range("B2").Resize(R1, C1).Value = dArr
    End With
    Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Sao bạn không lưu 2 giá trị cột lẫn dòng.Đỡ phải duyệt thêm 1 vòng lặp nữa.
 
Upvote 0
anhtuan2939 đã viết:
Lưu 2 giá trị cột lẫn dòng là như thế nào bạn nhỉ? Mình chưa rõ cái này lắm. Mong bạn chỉ thêm cho mình. Cám ơn!
Nhấp chuột vào đây để mở rộng...
Bạn thử mình chưa test nhé.Kiểu là như vậy.
Mã: 
Sub sumifs()
    Dim dic As Object, sArr(), dArr()
    Dim i As Long, j As Long, lr As Long, Row As Long, Col As Long, R1 As Long, C1 As Long, a As Long, b As Long
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheet1
            lr = .Range("A" & Rows.Count).End(xlUp).Row
        sArr = .Range("A1:M" & lr).Value
        R1 = UBound(sArr, 1)
        C1 = UBound(sArr, 2)
        ReDim dArr(1 To R1, 1 To C1)
        For i = 2 To R1
            dic.Item(sArr(i, 1)) = i - 1
        Next i
        For i = 2 To C1
            dic.Item(sArr(1, i)) = i - 1
        Next i
        lr = .Range("P" & Rows.Count).End(xlUp).Row
        sArr = .Range("P2:R" & lr).Value
        For i = 1 To UBound(sArr)
             a = dic.Item(sArr(i, 1))
             b = dic.Item(sArr(i, 2))
             If a > 0 And b > 0 Then
                dArr(a, b) = dArr(a, b) + sArr(i, 3)
             End If
        Next i
            .Range("B2").Resize(R1, C1).Value = dArr
    End With
    Set dic = Nothing
End Sub
 
Upvote 0
Dear
snow25 đã viết:
Bạn thử mình chưa test nhé.Kiểu là như vậy.
Mã: 
Sub sumifs()
    Dim dic As Object, sArr(), dArr()
    Dim i As Long, j As Long, lr As Long, Row As Long, Col As Long, R1 As Long, C1 As Long, a As Long, b As Long
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheet1
            lr = .Range("A" & Rows.Count).End(xlUp).Row
        sArr = .Range("A1:M" & lr).Value
        R1 = UBound(sArr, 1)
        C1 = UBound(sArr, 2)
        ReDim dArr(1 To R1, 1 To C1)
        For i = 2 To R1
            dic.Item(sArr(i, 1)) = i - 1
        Next i
        For i = 2 To C1
            dic.Item(sArr(1, i)) = i - 1
        Next i
        lr = .Range("P" & Rows.Count).End(xlUp).Row
        sArr = .Range("P2:R" & lr).Value
        For i = 1 To UBound(sArr)
             a = dic.Item(sArr(i, 1))
             b = dic.Item(sArr(i, 2))
             If a > 0 And b > 0 Then
                dArr(a, b) = dArr(a, b) + sArr(i, 3)
             End If
        Next i
            .Range("B2").Resize(R1, C1).Value = dArr
    End With
    Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
anhtuan2939 đã viết:
Công thức bạn hoạt động vì định dạng ngày tháng ở cột Q và ở hàng 1 sai giống nhau nên mới có kết quả. bạn kiểm tra lại nhé. Ngoài ra nếu bạn tổng hợp thì dữ liệu ở cột A không nên trùng nhau.
Bài đã được tự động gộp:


Sau khi bạn sửa lại định dạng thì dùng thử code này nhé:

Mã: 
Sub sumifs()
    Dim dic As Object, sArr(), dArr()
    Dim i As Long, j As Long, lr As Long, Row As Long, Col As Long, R1 As Long, C1 As Long
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheet1
            lr = .Range("A" & Rows.Count).End(xlUp).Row
        sArr = .Range("A2:M" & lr).Value
        R1 = UBound(sArr, 1)
        C1 = UBound(sArr, 2)
        ReDim dArr(1 To R1, 1 To C1)
        For i = 1 To R1
            dic.Item(sArr(i, 1)) = i
        Next i
       
            lr = .Range("P" & Rows.Count).End(xlUp).Row
        sArr = .Range("P2:R" & lr).Value
        For i = 1 To UBound(sArr)
            If dic.Exists(sArr(i, 1)) Then
                Row = dic.Item(sArr(i, 1))
                For Col = 1 To C1
                    If sArr(i, 2) = Cells(1, Col).Value Then dArr(Row, Col - 1) = dArr(Row, Col - 1) + sArr(i, 3)
                Next Col
            End If
        Next i
            .Range("B2").Resize(R1, C1).Value = dArr
    End With
    Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

Hi, Bạn

3 cột P,Q,R mình chuyển sang sheet 2 được không bạn, mình đang tập tành thử
Mong bạn hỗ trợ

thanks
1601860980754.png
 
Upvote 0
HO VAN DUNG đã viết:
em muốn dò thêm điều kiện ở 2 cột tô màu xanh lá cây nữa ạ
Nhấp chuột vào đây để mở rộng...
Bạn chạy thử xem
PHP: 
Sub sumifs()
    Dim dic As Object, sArr(), dArr()
    Dim i As Long, j As Long, lr As Long, Row As Long, Col As Long, R1 As Long, C1 As Long, a As Long, b As Long
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("tonghop")
            lr = .Range("B" & Rows.Count).End(xlUp).Row
        sArr = .Range("B1:AI" & lr).Value
        R1 = UBound(sArr, 1)
        C1 = UBound(sArr, 2)
        ReDim dArr(1 To R1, 1 To C1)
        For i = 4 To R1
            dic.Item(sArr(i, 1)) = i - 3
        Next i
        For i = 4 To C1
            dic.Item(sArr(1, i)) = i - 1
        Next i
    End With
    With Sheets("sl")
        lr = .Range("E" & Rows.Count).End(xlUp).Row
        sArr = .Range("E4:I" & lr).Value
        For i = 1 To UBound(sArr)
             a = dic.Item(sArr(i, 1))
             b = dic.Item(sArr(i, 4))
             If a > 0 Then
                dArr(a, 1) = sArr(i, 2)
                dArr(a, 2) = sArr(i, 3)
             End If
             If a > 0 And b > 0 Then
                dArr(a, b) = dArr(a, b) + sArr(i, 5)
                dArr(a, C1) = dArr(a, C1) + sArr(i, 5)
             End If
        Next i
    End With
        Sheets("tonghop").Range("C4").Resize(R1, C1).Value = dArr
    Set dic = Nothing
End Sub
 
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

K
  • Question
Sử dụng Power Query để xử lý nhật ký chung nhiều nợ nhiều có
    • Cười
Trả lời
13
Đọc
214
ptm0412
ptm0412
Huy@@*
Giải đáp giùm em, cách khắc phục lỗi này trên VBA
2
Trả lời
28
Đọc
308
ptm0412
ptm0412
SA_DQ
Phẩu thuật Nụ cười lần 3 tại Huế.
    • Thích
Trả lời
0
Đọc
23
SA_DQ
SA_DQ
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
7 8 9
Trả lời
175
Đọc
9K
ongke0711
ongke0711
E
  • Question
Tạo bảng lọc theo điều kiện
Trả lời
7
Đọc
118
Hoàng Tuấn 868
H
N
Giúp em hàm Aggregate không chạy được trên Google sheet ah
Trả lời
1
Đọc
52
BuiQuangThuan
B
Bùi Thúy Thúy
  • Question
Lấy dữ liệu thời tiết Accuweather để điền vào nhật ký thi công
2 3 4
Trả lời
62
Đọc
18K
HeSanbi
HeSanbi
B
Nhờ anh/chị giúp em tìm hàm cho công thức tính lương
Trả lời
0
Đọc
44
Bobomkkk
B
vova2209
Index kết hợp với match 2 điều kiện
Trả lời
14
Đọc
1K
dunghtgiga
dunghtgiga
D
  • Question
Xin cách tạo tab và button cho Add-in trên ribbon Maintabs
Trả lời
2
Đọc
93
Decepticon
D
N
cộng các dữ liệu không trùng nhau
Trả lời
12
Đọc
190
Nguyễn Hiền1508
N
T
Chèn dữ liệu từ sheet này qua sheet khác theo điều kiện
Trả lời
3
Đọc
133
HieuCD
H
T
Trùng 2 lần: Tìm dữ liệu nhiều điều kiện
Trả lời
0
Đọc
80
Thulib
T
N
  • Question
Xin mã code ẩn hiện dòng theo điều kiện
Trả lời
10
Đọc
112
Nguyễn Diêu Hiền
N
N
Công thức tính số phù hợp với % mong muốn
Trả lời
9
Đọc
161
CHAOQUAY
C
B
Giúp em xử lý lỗi macro khi chạy VBA
2
Trả lời
21
Đọc
458
huhumalu
H
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
6
Đọc
335
DeTong
D
T
cả nhà hỗ trợ giúp em là em phải dùng hàm gì cho đúng ạ, em làm mãi không được
    • Cười
Trả lời
2
Đọc
108
DeTong
D
nguyenanhhoa
Nhờ các bác giúp: e muốn tô màu khác nhau đối với các ô giống nhau về giá trị
    • Cười
Trả lời
7
Đọc
144
SA_DQ
SA_DQ
LuuAnh980
Từ "cân đối" trong tiếng Anh là gì?
2 3
Trả lời
44
Đọc
2K
VetMini
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