Nhờ giúp đỡ code sumifs

Eric.Shen · 20/5/23

Chào các bác,
Em đang tìm hiểu về dic trong VBA, qua diễn đàn em có tham khảo được 1 đoạn code thay thế cho hàm sumif, tuy nhiên với trường hợp dữ liệu lặp lại thì nó lại chưa trả về kết quả.
Kính nhờ các bác giúp em sửa đoạn code để nó có thể chạy được ạ
Chi tiết em có gửi trong file đính kèm
Em cảm ơn ạ!

BuiQuangThuan · 20/5/23

Eric.Shen đã viết:
Kính nhờ các bác giúp em sửa đoạn code để nó có thể chạy được ạ

Chỉ cần nó chạy được thôi chứ không cần đúng kết quả cũng được hả

Eric.Shen · 20/5/23

BuiQuangThuan đã viết:
Chỉ cần nó chạy được thôi chứ không cần đúng kết quả cũng được hả

Cần đúng nữa bác ạ, em viết chưa đầy đủ

BuiQuangThuan · 20/5/23

Eric.Shen đã viết:
Cần đúng nữa bác ạ, em viết chưa đầy đủ

Tham khảo thêm khi chờ các thành viên khác giúp nữa. Mà bạn có thể bỏ chữ Nhờ trong tiêu đề đi được không?

Mã:

Sub ABC()
    Dim Dic As Object, sArr(), Res(), i&, j&, k&
    Set Dic = CreateObject("Scripting.dictionary")
    With Sheets("Sheet1")
        sArr = .Range("B3:D" & .Range("B" & Rows.Count).End(3).Row).Value
        For i = 1 To UBound(sArr)
            Dic(sArr(i, 1)) = Dic(sArr(i, 1)) + sArr(i, 2)
        Next
    End With
    With Sheets("Sheet2")
        sArr = .Range("B3:B" & .Range("B" & Rows.Count).End(3).Row).Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = True Then
                Res(i, 1) = Dic.Item(sArr(i, 1))
            End If
        Next
        Sheets("Sheet2").Range("D3").Resize(UBound(Res), 1) = Res
    End With
End Sub

Hoàng Tuấn 868 · 20/5/23

BuiQuangThuan đã viết:

Tham khảo thêm khi chờ các thành viên khác giúp nữa. Mà bạn có thể bỏ chữ Nhờ trong tiêu đề đi được không?

Mã:

Sub ABC()
    Dim Dic As Object, sArr(), Res(), i&, j&, k&
    Set Dic = CreateObject("Scripting.dictionary")
    With Sheets("Sheet1")
        sArr = .Range("B3:D" & .Range("B" & Rows.Count).End(3).Row).Value
        For i = 1 To UBound(sArr)
            Dic(sArr(i, 1)) = Dic(sArr(i, 1)) + sArr(i, 2)
        Next
    End With
    With Sheets("Sheet2")
        sArr = .Range("B3:B" & .Range("B" & Rows.Count).End(3).Row).Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = True Then
                Res(i, 1) = Dic.Item(sArr(i, 1))
            End If
        Next
        Sheets("Sheet2").Range("D3").Resize(UBound(Res), 1) = Res
    End With
End Sub

Sao không có dòng cho "C" mà lại có hai dòng cho "A" nhỉ?

BuiQuangThuan · 20/5/23

Hoàng Tuấn 868 đã viết:
Sao không có dòng cho "C" mà lại có hai dòng cho "A" nhỉ?

Em nghi là dòng 3 nó là "C". Thớt muốn test lại kết quả nên thử thay bằng "A" lại xem sao. Ai dè nó ra kết quả không đúng. Chứ code ban đầu của Thớt cũng chạy được mà. Chứ có lỗi lầm gì đâu. chỉ mỗi ra kết quả không đúng thôi. Hi hi

Eric.Shen · 20/5/23

BuiQuangThuan đã viết:

Tham khảo thêm khi chờ các thành viên khác giúp nữa. Mà bạn có thể bỏ chữ Nhờ trong tiêu đề đi được không?

Mã:

Sub ABC()
    Dim Dic As Object, sArr(), Res(), i&, j&, k&
    Set Dic = CreateObject("Scripting.dictionary")
    With Sheets("Sheet1")
        sArr = .Range("B3:D" & .Range("B" & Rows.Count).End(3).Row).Value
        For i = 1 To UBound(sArr)
            Dic(sArr(i, 1)) = Dic(sArr(i, 1)) + sArr(i, 2)
        Next
    End With
    With Sheets("Sheet2")
        sArr = .Range("B3:B" & .Range("B" & Rows.Count).End(3).Row).Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = True Then
                Res(i, 1) = Dic.Item(sArr(i, 1))
            End If
        Next
        Sheets("Sheet2").Range("D3").Resize(UBound(Res), 1) = Res
    End With
End Sub

Em cảm ơn bác nhiều ạ!

Mà bạn có thể bỏ chữ Nhờ trong tiêu đề đi được không?

Em sẽ lưu ý hơn bác nhé

Bài đã được tự động gộp: 20/5/23

Hoàng Tuấn 868 đã viết:
Sao không có dòng cho "C" mà lại có hai dòng cho "A" nhỉ?

Vì trong quá trình em sử dụng có trường hợp giá trị cần tính tổng lại lặp lại chứ không phải duy nhất bác ạ

Bài đã được tự động gộp: 20/5/23

BuiQuangThuan đã viết:
Em nghi là dòng 3 nó là "C". Thớt muốn test lại kết quả nên thử thay bằng "A" lại xem sao. Ai dè nó ra kết quả không đúng. Chứ code ban đầu của Thớt cũng chạy được mà. Chứ có lỗi lầm gì đâu. chỉ mỗi ra kết quả không đúng thôi. Hi hi

vâng, em có mấy trường hợp cần tính mà em lại chưa thạo nên chưa tự sửa code được bác ạ

Hoàng Tuấn 868 · 20/5/23

Eric.Shen đã viết:
Vì trong quá trình em sử dụng có trường hợp giá trị cần tính tổng lại lặp lại chứ không phải duy nhất bác ạ

Nếu tính tổng lặp lại thì khác gì tổng đầu tiên đâu bạn nhỉ?

Eric.Shen · 20/5/23

Hoàng Tuấn 868 đã viết:
Nếu tính tổng lặp lại thì khác gì tổng đầu tiên đâu bạn nhỉ?

tại cái code ban đầu của em nó chưa đáp ứng được mà bản thân em lại chưa tự sửa được bác ạ

Hoàng Tuấn 868 · 20/5/23

Eric.Shen đã viết:
tại cái code ban đầu của em nó chưa đáp ứng được mà bản thân em lại chưa tự sửa được bác ạ

Bạn thử tham khảo thêm.

BuiQuangThuan · 20/5/23

Hoàng Tuấn 868 đã viết:
Bạn thử tham khảo thêm.

Em đề nghị anh gắn code vào thẻ code cho em coi và học với. Chứ đính kèm file lười tải không có nhìn thấy gì để học cả

Hoàng Tuấn 868 · 20/5/23

BuiQuangThuan đã viết:
Em đề nghị anh gắn code vào thẻ code cho em coi và học với. Chứ đính kèm file lười tải không có nhìn thấy gì để học cả

Đáp ứng đề nghị nhé.

Mã:

Sub Thay_SUMIF()
Dim shn As Worksheet, shd As Worksheet
Dim Dic As Object, mn, md, i As Long, j As Long, k As Long, lrn As Long

Set Dic = CreateObject("Scripting.dictionary")
Set shn = ThisWorkbook.Sheets("sheet1"): Set shd = ThisWorkbook.Sheets("sheet2")
lrn = shn.Cells(Rows.Count, 2).End(xlUp).Row
mn = shn.Range("B3:C" & lrn)
ReDim md(1 To UBound(mn, 1), 1 To 3)

    For i = 1 To UBound(mn, 1)
        If Not Dic.exists(mn(i, 1)) Then
            k = k + 1
            Dic.Add mn(i, 1), k
            md(k, 1) = k
            md(k, 2) = mn(i, 1)
            md(k, 3) = mn(i, 2)
        Else
            j = Dic.Item(mn(i, 1))
            md(j, 3) = md(j, 3) + mn(i, 2)
        End If
    Next i
    
shd.Range("A3:C10000").ClearContents
shd.Range("A3").Resize(k, 3) = md
End Sub

Nhattanktnn · 20/5/23

Eric.Shen đã viết:
Chào các bác,
Em đang tìm hiểu về dic trong VBA, qua diễn đàn em có tham khảo được 1 đoạn code thay thế cho hàm sumif, tuy nhiên với trường hợp dữ liệu lặp lại thì nó lại chưa trả về kết quả.
Kính nhờ các bác giúp em sửa đoạn code để nó có thể chạy được ạ
Chi tiết em có gửi trong file đính kèm
Em cảm ơn ạ!

Góp vui một cách khác:

Mã:

Sub NT()
Dim ls As String, rng As Range
Set rng = Sheets("sheet1").Range("B3:C" & Sheets("sheet1").Cells(Rows.Count, "B").End(xlUp).Row)
ls = Replace(rng.Address(, , xlR1C1, 1, 1), "[", ThisWorkbook.Path & "\[")
Sheets("Sheet2").Range("B3").Consolidate Sources:=ls, Function:=xlSum, LeftColumn:=True
End Sub

ptm0412 · 20/5/23

BuiQuangThuan đã viết:
Tham khảo thêm khi chờ các thành viên khác giúp nữa. Mà bạn có thể bỏ chữ Nhờ trong tiêu đề đi được không?

Có chữ nhờ là rất lịch sự, tại sao phải bỏ?
Bỏ "nhờ" còn lại "Giúp đỡ code hàm SumIfs" lại nói bỏ chữ "giúp đỡ"
Cuối cùng nó trụi lủi "Code hàm SumIfs" lại bảo "không rõ ràng"

BuiQuangThuan · 20/5/23

ptm0412 đã viết:
Có chữ nhờ là rất lịch sự, tại sao phải bỏ?
Bỏ "nhờ" còn lại "Giúp đỡ code hàm SumIfs" lại nói bỏ chữ "giúp đỡ"
Cuối cùng nó trụi lủi "Code hàm SumIfs" lại bảo "không rõ ràng"

Theo cháu chữ nhờ giúp đỡ sẽ đưa vào trong bài viết. Bởi mặc định cháu nghĩ tiêu đề chỉ cần ngắn gọn đủ ý là được. Cá nhân cháu nghĩ vậy. Hihi

Hoàng Tuấn 868 · 20/5/23

BuiQuangThuan đã viết:
Theo cháu chữ nhờ giúp đỡ sẽ đưa vào trong bài viết. Bởi mặc định cháu nghĩ tiêu đề chỉ cần ngắn gọn đủ ý là được. Cá nhân cháu nghĩ vậy. Hihi

Trường hợp này có lẽ tiêu đề nên là: "Code VBA thay thế hàm SUMIF" sẽ thuận tiện cho việc tìm kiếm nhanh hơn.

Eric.Shen · 20/5/23

Hoàng Tuấn 868 đã viết:
Bạn thử tham khảo thêm.

Em cảm ơn bác nhiều ạ
Em sẽ tham khảo cách viết này ạ

Bài đã được tự động gộp: 20/5/23

Nhattanktnn đã viết:

Góp vui một cách khác:

Mã:

Sub NT()
Dim ls As String, rng As Range
Set rng = Sheets("sheet1").Range("B3:C" & Sheets("sheet1").Cells(Rows.Count, "B").End(xlUp).Row)
ls = Replace(rng.Address(, , xlR1C1, 1, 1), "[", ThisWorkbook.Path & "\[")
Sheets("Sheet2").Range("B3").Consolidate Sources:=ls, Function:=xlSum, LeftColumn:=True
End Sub

Em cảm ơn bác nhiều ạ
Cách viết này em chưa hiểu được, em sẽ nghiên cứu thêm ạ

Bài đã được tự động gộp: 20/5/23

Hoàng Tuấn 868 đã viết:
Trường hợp này có lẽ tiêu đề nên là: "Code VBA thay thế hàm SUMIF" sẽ thuận tiện cho việc tìm kiếm nhanh hơn.

Vâng, ban đầu em nghĩ nếu viết vậy sợ là có một số bác sẽ lại hiểu là em gửi code lên thay vì là nhờ giúp đỡ ạ.
Cảm ơn bác đã góp ý cho em

VetMini · 20/5/23

Hoàng Tuấn 868 đã viết:
Trường hợp này có lẽ tiêu đề nên là: "Code VBA thay thế hàm SUMIF" sẽ thuận tiện cho việc tìm kiếm nhanh hơn.

Khổ nổi bản thân bài này, tiêu đề thì Sumifs, vô bài #1 thành SumIf.
Từ đầu thớt đã lọng cọng, đòi "tìm hiểu về" đít sần với đít sẹo.

ptm0412 · 20/5/23

Hoàng Tuấn 868 đã viết:
Trường hợp này có lẽ tiêu đề nên là: "Code VBA thay thế hàm SUMIF" sẽ thuận tiện cho việc tìm kiếm nhanh hơn.

Đọc tiêu đề "Code VBA thay thế hàm SUMIF" lại tưởng ai đó chia sẻ 1 siêu hàm.
Theo tôi, tiêu đề có nội dung chính là được, nhờ giúp là 1 câu lịch sự không nên bắt lỗi.

Eric.Shen · 22/5/23

VetMini đã viết:
Khổ nổi bản thân bài này, tiêu đề thì Sumifs, vô bài #1 thành SumIf.
Từ đầu thớt đã lọng cọng, đòi "tìm hiểu về" đít sần với đít sẹo.

Cho dù 1 điều kiện vẫn dùng sumifs được mà bác, cái này là do thói quen của mỗi người thôi ạ
chỉ vì thói quen dùng hàm này mà không thể tìm hiểu về dic được à bác ơi

Nhờ giúp đỡ code sumifs

Thành viên chính thức

File đính kèm

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên chính thức

❆❆❆❆❆❆❆❆❆❆❆❆

Đăng ký hôm qua

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên chính thức

Đăng ký hôm qua

Thành viên chính thức

Đăng ký hôm qua

File đính kèm

❆❆❆❆❆❆❆❆❆❆❆❆

Đăng ký hôm qua

Thành viên gắn bó

Bad Excel Member

❆❆❆❆❆❆❆❆❆❆❆❆

Đăng ký hôm qua

Thành viên chính thức

Ăn cùng góc phố

Bad Excel Member

Thành viên chính thức