Tính tổng với nhiều điều kiện

[Nhật Anh 9x]

Em chào anh chị

Hôm nay em có một vấn đề như sau cần anh chị chỉ dạy cho em ạ:

Em tính tổng có điều kiện từ 1 sheets("data") muốn khi em có thay điều kiện (ở cột A hoặc F) hoặc số liệu (ở cột I) trong sheets("data") thì sheets("sumifs") tự động tính tổng lại những điều kiện có thay đổi còn những điều kiện không thay đổi thì giữ nguyên, vì anh chị cũng biết nếu sumifs tính nhiều dòng thì chạy cũng rất lâu ạ, nhưng code e viết thì chỉ chay đc khi cột I thay đổi thôi ạ còn nếu em thay đổi điều kiện ở cột A và F hoặc em thêm mới dữ liệu sau dòng cuối của sheets("data") thì code lại báo lỗi không chạy được ạ. Em có file đính kèm anh chị xem qua giúp em với ạ!

Em cảm ơn anh chị!

 

[snow25]

Em chào anh chị

Hôm nay em có một vấn đề như sau cần anh chị chỉ dạy cho em ạ:

Em tính tổng có điều kiện từ 1 sheets("data") muốn khi em có thay điều kiện (ở cột A hoặc F) hoặc số liệu (ở cột I) trong sheets("data") thì sheets("sumifs") tự động tính tổng lại những điều kiện có thay đổi còn những điều kiện không thay đổi thì giữ nguyên, vì anh chị cũng biết nếu sumifs tính nhiều dòng thì chạy cũng rất lâu ạ, nhưng code e viết thì chỉ chay đc khi cột I thay đổi thôi ạ còn nếu em thay đổi điều kiện ở cột A và F hoặc em thêm mới dữ liệu sau dòng cuối của sheets("data") thì code lại báo lỗi không chạy được ạ. Em có file đính kèm anh chị xem qua giúp em với ạ!

Em cảm ơn anh chị!

Bạn đã viết code để thay thế hàm Sumif thì nên dùng Dictionary và array nó sẽ nhanh hơn.Nếu mà thay đổi và tính lại như bạn thì cũng không khác với hàm nó chạy lắm.Sao không làm 1 nút bấm cái là xong.

 

[bebo021999]

Bạn làm theo cách này:
Tại general module, module1:

Option Explicit
Sub Sum_If()
Dim lr&, i&, id As String, rng, res(), dic As Object, key
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("data")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:I" & lr).Value
    For i = 1 To UBound(rng)
        If IsNumeric(rng(i, 9)) Then
            id = rng(i, 1) & "|" & rng(i, 6)
            If Not dic.exists(id) And rng(i, 1) <> "" Then
                dic.Add id, rng(i, 9)
            Else
                dic(id) = dic(id) + rng(i, 9)
            End If
        End If
    Next
End With
i = 0: ReDim res(1 To dic.Count, 1 To 3)
For Each key In dic.keys
    i = i + 1
    res(i, 1) = Split(key, "|")(0)
    res(i, 2) = Split(key, "|")(1)
    res(i, 3) = dic(key)
Next
With Sheets("sumifs").Range("A1")
    .Resize(100000, 3).ClearContents
    .Resize(dic.Count, 3).Value = res
End With
End Sub

Tại modul sheet "data"

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Union(Columns("A"), Columns("F"), Columns("I"))) Is Nothing Then Exit Sub
Sum_If
End Sub

 

[HUONGHCKT]

Em chào anh chị

Hôm nay em có một vấn đề như sau cần anh chị chỉ dạy cho em ạ:

Em tính tổng có điều kiện từ 1 sheets("data") muốn khi em có thay điều kiện (ở cột A hoặc F) hoặc số liệu (ở cột I) trong sheets("data") thì sheets("sumifs") tự động tính tổng lại những điều kiện có thay đổi còn những điều kiện không thay đổi thì giữ nguyên, vì anh chị cũng biết nếu sumifs tính nhiều dòng thì chạy cũng rất lâu ạ, nhưng code e viết thì chỉ chay đc khi cột I thay đổi thôi ạ còn nếu em thay đổi điều kiện ở cột A và F hoặc em thêm mới dữ liệu sau dòng cuối của sheets("data") thì code lại báo lỗi không chạy được ạ. Em có file đính kèm anh chị xem qua giúp em với ạ!

Em cảm ơn anh chị!

Góp vui :
Thử tham khảo code này:
Thay code trong Sub tesst() bằng code này

Sub SumNhieuDieuKien()
Dim lr1 As Long, t&, k&
Dim Arr(), KQ()
Dim Dic As Object, Key
M = Timer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Sheet1
lr1 = .Range("A" & Rows.Count).End(xlUp).Row 'sheet du lieu nguon
Arr = .Range("A2:I" & lr1).Value
End With
ReDim KQ(1 To UBound(Arr), 1 To 3)
Set Dic = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(Arr)
    Key = Arr(i, 1) & "#" & Arr(i, 6)
    If Not Dic.exists(Key) Then
        t = t + 1: Dic.Add (Key), t
        KQ(t, 1) = Split(Key, "#")(0)
        KQ(t, 2) = Split(Key, "#")(1)
        If IsNumeric(Arr(i, 9)) Then KQ(t, 3) = Arr(i, 9)
    Else
        k = Dic.Item(Key)
        If IsNumeric(Arr(i, 9)) Then KQ(k, 3) = KQ(k, 3) + Arr(i, 9)
    End If
Next i
If t Then
    Sheet2.Range("A1").Resize(10000, 3).ClearContents
    Sheet2.Range("A1").Resize(t, 3) = KQ
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox Timer - M
End Sub
và thay code trong sheet(data) bằng code này
[code]
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Union(Columns("A"), Columns("F"), Columns("I"))) Is Nothing Then
    Exit Sub
Else
    Sum_If
End If
End Sub

 

[Nhật Anh 9x]

Bạn làm theo cách này:
Tại general module, module1:

Option Explicit
Sub Sum_If()
Dim lr&, i&, id As String, rng, res(), dic As Object, key
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("data")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:I" & lr).Value
    For i = 1 To UBound(rng)
        If IsNumeric(rng(i, 9)) Then
            id = rng(i, 1) & "|" & rng(i, 6)
            If Not dic.exists(id) And rng(i, 1) <> "" Then
                dic.Add id, rng(i, 9)
            Else
                dic(id) = dic(id) + rng(i, 9)
            End If
        End If
    Next
End With
i = 0: ReDim res(1 To dic.Count, 1 To 3)
For Each key In dic.keys
    i = i + 1
    res(i, 1) = Split(key, "|")(0)
    res(i, 2) = Split(key, "|")(1)
    res(i, 3) = dic(key)
Next
With Sheets("sumifs").Range("A1")
    .Resize(100000, 3).ClearContents
    .Resize(dic.Count, 3).Value = res
End With
End Sub

Tại modul sheet "data"

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Union(Columns("A"), Columns("F"), Columns("I"))) Is Nothing Then Exit Sub
Sum_If
End Sub

Cảm ơn anh trai vì đã giải cho em nhiều bài hay, cách của anh trai rất hay, nhưng bài này của em với ý muốn là dữ liệu cần tính tổng ở sheets("sumifs") là cố định anh ạ (cụ thể cột A, B cố định), nếu em dùng dic thì các kết quả từ điều kiện lại thay đổi lại từ đầu. ý em ở đây là các cột điều kiện ở sheets("sumifs") của em là cố định có trước, theo thứ tự rồi còn data là dữ liệu em làm sau, giống kiểu em có một mã hàng e biết trc mã hàng đó gồm cái gì e điền vào cột A B của sheets("sumifs"), sau đó em có nhập hàng về (dữ liệu nhập sẽ ở sheets("data")) em phân ra hàng đó thuộc mã nào loại nào trong sheets("sumifs"). thì bên sheets("sumifs") tự động tính tổng lại mà k thay đổi vị trí anh ạ

 

[bebo021999]

OK. Vậy dùng code này. Chỉ để cập nhật dòng nào có sự thay đổi thôi nhé.
Dán vào worksheet module.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr&, i&, year&, code As String, val As Double, sum, rng, f, addr As String
If Intersect(Target, Union(Columns("A"), Columns("F"), Columns("I"))) Is Nothing Then Exit Sub

'khi dòng thay doi thi cap nhat year, code va gia tri cua dong do
year = Cells(Target.Row, "A").Value: code = Cells(Target.Row, "F").Value: val = Cells(Target.Row, "I").Value
If year <= 0 Or code = "" Or val = 0 Then Exit Sub
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A2:I" & lr).Value

'Cong don (sumifs) sheet data, tra ve ket qua sum
For i = 1 To UBound(rng)
    If rng(i, 1) = year And rng(i, 6) = code Then sum = sum + rng(i, 9)
Next
With Sheets("sumifs")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    
    'Tim gia tri nam trong cot A sheet sumifs
    Set f = .Columns(1).Find(year)
    
    'Nêu tìm thay nam thì kiêm tra code, neu code trung thi dan gia tri sum vao o và thoat
    If Not f Is Nothing Then
        addr = f.Address
        Do
            If f.Offset(0, 1).Value = code Then
                f.Offset(0, 2).Value = sum
                Exit Sub
            End If
            'Neu code khong trung thi tiep tuc tim nam
            Set f = .Columns(1).FindNext(f)
        Loop Until f.Address = addr ' lap lai cho den khi gia tri tim thay quay ve o dau tien
     End If
     
     'Neu sau khi tim trong cot A,B ma khong thay, co nghia la gia tri nay moi phat sinh. Dan ps moi nay vao dong cuoi cung
     .Cells(lr + 1, "A").Value = year
     .Cells(lr + 1, "B").Value = code
     .Cells(lr + 1, "C").Value = sum
End With
End Sub

 

[phansythao]

Bài toán của bạn dùng pivot table được giải quyết nhanh chóng. Việc tự động cập nhật dữ liệu cũng được rút gọn bằng 1 vài dòng code đơn giản bằng việc record macro.
Tại sao chủ topic không dùng pivot thế?

 

[Nhật Anh 9x]

OK. Vậy dùng code này. Chỉ để cập nhật dòng nào có sự thay đổi thôi nhé.
Dán vào worksheet module.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr&, i&, year&, code As String, val As Double, sum, rng, f, addr As String
If Intersect(Target, Union(Columns("A"), Columns("F"), Columns("I"))) Is Nothing Then Exit Sub

'khi dòng thay doi thi cap nhat year, code va gia tri cua dong do
year = Cells(Target.Row, "A").Value: code = Cells(Target.Row, "F").Value: val = Cells(Target.Row, "I").Value
If year <= 0 Or code = "" Or val = 0 Then Exit Sub
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A2:I" & lr).Value

'Cong don (sumifs) sheet data, tra ve ket qua sum
For i = 1 To UBound(rng)
    If rng(i, 1) = year And rng(i, 6) = code Then sum = sum + rng(i, 9)
Next
With Sheets("sumifs")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
   
    'Tim gia tri nam trong cot A sheet sumifs
    Set f = .Columns(1).Find(year)
   
    'Nêu tìm thay nam thì kiêm tra code, neu code trung thi dan gia tri sum vao o và thoat
    If Not f Is Nothing Then
        addr = f.Address
        Do
            If f.Offset(0, 1).Value = code Then
                f.Offset(0, 2).Value = sum
                Exit Sub
            End If
            'Neu code khong trung thi tiep tuc tim nam
            Set f = .Columns(1).FindNext(f)
        Loop Until f.Address = addr ' lap lai cho den khi gia tri tim thay quay ve o dau tien
     End If
    
     'Neu sau khi tim trong cot A,B ma khong thay, co nghia la gia tri nay moi phat sinh. Dan ps moi nay vao dong cuoi cung
     .Cells(lr + 1, "A").Value = year
     .Cells(lr + 1, "B").Value = code
     .Cells(lr + 1, "C").Value = sum
End With
End Sub

Em vừa thử nhưng nếu giả sử em thay đổi ô F2 trong sheets("data") đang là H01 thành H02 or thay đổi ô A2 trong sheets("data") đang là 2021 thành 2020 hoặc thêm mới dòng dữ liệu trong sheets("data") thì giá trị bên sheets("sumifs") lại không thay đổi hoặc báo lỗi anh ạ, anh chỉnh thêm giúp em với ạ

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

Bài toán của bạn dùng pivot table được giải quyết nhanh chóng. Việc tự động cập nhật dữ liệu cũng được rút gọn bằng 1 vài dòng code đơn giản bằng việc record macro.
Tại sao chủ topic không dùng pivot thế?

Cũng có người bảo em là dùng power query hay power bi gì đó nhưng cơ bản là em chưa học nên em muốn tận dụng code vba đã chị ạ, cái gì mình biết thì mình làm trước ạ, e nghĩ các anh chị ở đây cũng xử lý được ạ vì vba cũng tuỳ biến mà

 

[Hoàng Tuấn 868]

Em vừa thử nhưng nếu giả sử em thay đổi ô F2 trong sheets("data") đang là H01 thành H02 or thay đổi ô A2 trong sheets("data") đang là 2021 thành 2020 hoặc thêm mới dòng dữ liệu trong sheets("data") thì giá trị bên sheets("sumifs") lại không thay đổi hoặc báo lỗi anh ạ, anh chỉnh thêm giúp em với ạ
View attachment 288137

Có bao nhiêu cái "nếu giả sử" mà diễn giải luôn một thể thì đỡ biết mấy.

 

[snow25]

Có bao nhiêu cái "nếu giả sử" mà diễn giải luôn một thể thì đỡ biết mấy.

Ở đầu bài họ cũng bảo là thay đổi rồi mà.Nhưng code mà để tỉnh tổng mà thay đổi thì phải chạy lại data vì không biết nó thay đổi cái gì rất khó để kiểm soát.Còn mỗi lần thay đổi mà gọi lại code tính tổng 1 lần thì không khả thi với dữ liệu lớn.Nguyên thời gian nó lấy dữ liệu từ Range vào mảng cũng mất kha khá thời gian rồi.

 

[bebo021999]

Khi bạn cập nhật thay đổi kiểu này rất khó quản lý.
VD:
Dữ liệu cũ:
2021 - H01 - 100
Lỡ bạn vô tình sửa 2021 thành 2099 chẳng hạn, code sẽ xem nó là 1 phát sinh mới hoàn toàn và thêm 1 dòng vào vùng kết quả.
Khi bạn undo, hoặc sửa lại 2099 thành 2021 thì dòng 2099 vẫn còn nguyên, và nó lại thêm 1 dòng mới 2021 nữa...

 

[ptm0412]

Cũng có người bảo em là dùng power query hay power bi gì đó nhưng cơ bản là em chưa học nên em muốn tận dụng code vba đã chị ạ, cái gì mình biết thì mình làm trước ạ, e nghĩ các anh chị ở đây cũng xử lý được ạ vì vba cũng tuỳ biến mà

Chỉ cần Pivot table, chưa cần đại đao Power query hay Power BI.
Viết thêm code refresh

Private Sub Worksheet_Activate()
PivotTables(1).PivotCache.Refresh
End Sub

Cái này đơn giản là kéo thả và có thể tự làm, chứ dựa dẫm mãi sao?

 

[Nhật Anh 9x]

Khi bạn cập nhật thay đổi kiểu này rất khó quản lý.
VD:
Dữ liệu cũ:
2021 - H01 - 100
Lỡ bạn vô tình sửa 2021 thành 2099 chẳng hạn, code sẽ xem nó là 1 phát sinh mới hoàn toàn và thêm 1 dòng vào vùng kết quả.
Khi bạn undo, hoặc sửa lại 2099 thành 2021 thì dòng 2099 vẫn còn nguyên, và nó lại thêm 1 dòng mới 2021 nữa...

Vậy nên em mới phải dùng sumifs ấy anh, nhưng code viết trong sheets("data") còn hạn chế như em đã nói. Cảm ơn anh đã chỉ dạy. Mỗi bài có một tình huống khác nhau tạo nên cái khó riêng, bài này của em thì đúng là em đang làm như vậy anh ạ. phải chờ xem có cách nào hiệu quả hơn không ạ!

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

Chỉ cần Pivot table, chưa cần đại đao Power query hay Power BI.
Viết thêm code refresh

Private Sub Worksheet_Activate()
PivotTables(1).PivotCache.Refresh
End Sub

Cái này đơn giản là kéo thả và có thể tự làm, chứ dựa dẫm mãi sao?

View attachment 288163

Vâng, em cảm ơn anh!