Code VBA thay thế hàm Countifs (3 người xem)

dungluyen2119 · 11/4/23

Thưa các Bác. Chả là e đang tổng hợp dữ liệu báo cáo cho công ty mà dữ liệu lên đến cả trăm nghìn sản phẩm. Không thể dùng hàm Countifs để đếm được vì file nặng và chậm. Em kính mong các Bác giúp em code VBA để giải quyết bài toán này. Đếm số lượng lỗi của 1 sản phẩm theo hiện trạng lỗi. Em có gửi file đính kèm. các bác giúp em vói ạ. em xin cảm ơn!

BuiQuangThuan · 11/4/23

Sao lại từ chối hàm của bác Bill thế bạn? Tìm hiểu thêm về dictionary để viết nhé

dungluyen2119 · 11/4/23

BuiQuangThuan đã viết:
Sao lại từ chối hàm của bác Bill thế bạn

Không phải từ chối đâu Bác là do hoàn cảnh Bác à. Các sếp mở báo cáo mà mất 5 phút mới mở dc file là thôi ôm sầu ạ

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

BuiQuangThuan đã viết:
Sao lại từ chối hàm của bác Bill thế bạn? Tìm hiểu thêm về dictionary để viết nhé

Bác có thể giúp e được không ạ

namvu230397 · 11/4/23

Mình tưởng hàm của bác Bill phải hơn đứt VBA chứ nhỉ. File chậm chắc là do bạn đặt quá nhiều công thức, nhiều name và style rác hoặc link file chồng chéo với nhau. Bạn kiểm tra thử file gốc xem

dungluyen2119 · 11/4/23

namvu230397 đã viết:
Mình tưởng hàm của bác Bill phải hơn đứt VBA chứ nhỉ. File chậm chắc là do bạn đặt quá nhiều công thức, nhiều name và style rác hoặc link file chồng chéo với nhau. Bạn kiểm tra thử file gốc xem

Dùng nhiều hàm quá khi mở file lên nó nặng lắm bác ạ. Vậy nên e muốn dùng Code VBA để tối ưu việc này mà cũng đỡ sai hơn đó bác

quangminhici · 11/4/23

Thay vì dùng countif sao bạn không dùng pivot?

barney1 · 11/4/23

Trong khi chờ code khác, thử dùng code này xem
Option Explicit

Sub DemSoLoiHinhAnhVaNgoaiQuan()
Dim ws As Worksheet
Dim lastRow As Long
Dim productCodeRange As Range
Dim productCodeCell As Range
Dim productCode As String
Dim errorImageCount As Integer
Dim errorExternalCount As Integer

Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

Set productCodeRange = ws.Range("J1:J" & lastRow)
For Each productCodeCell In productCodeRange
productCode = productCodeCell.Value
errorImageCount = 0
errorExternalCount = 0
For i = 1 To lastRow

If ws.Cells(i, "D").Value = productCode Then

errorImageCount = errorImageCount + ws.Cells(i, "E").Value

errorExternalCount = errorExternalCount + ws.Cells(i, "F").Value
End If
Next i

productCodeCell.Offset(0, 2).Value = errorImageCount
productCodeCell.Offset(0, 3).Value = errorExternalCount
Next productCodeCell
End Sub

dungluyen2119 · 11/4/23

quangminhici đã viết:
Thay vì dùng countif sao bạn không dùng pivot?

Em đã nghĩ tới, cơ mà sếp em khó tính anh ạ

((

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

gacel đã viết:
Trong khi chờ code khác, thử dùng code này xem
Option Explicit

Sub DemSoLoiHinhAnhVaNgoaiQuan()
Dim ws As Worksheet
Dim lastRow As Long
Dim productCodeRange As Range
Dim productCodeCell As Range
Dim productCode As String
Dim errorImageCount As Integer
Dim errorExternalCount As Integer

Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

Set productCodeRange = ws.Range("J1:J" & lastRow)
For Each productCodeCell In productCodeRange
productCode = productCodeCell.Value
errorImageCount = 0
errorExternalCount = 0
For i = 1 To lastRow

If ws.Cells(i, "D").Value = productCode Then

errorImageCount = errorImageCount + ws.Cells(i, "E").Value

errorExternalCount = errorExternalCount + ws.Cells(i, "F").Value
End If
Next i

productCodeCell.Offset(0, 2).Value = errorImageCount
productCodeCell.Offset(0, 3).Value = errorExternalCount
Next productCodeCell
End Sub

Vâng, cảm ơn bác, để e thư xem ạ

Sonkull · 11/4/23

up cái file trăm nghìn sản phẩm lên mọi ng test ms biết tốc độ dc bạn

Hoàng Tuấn 868 · 11/4/23

gacel đã viết:
Trong khi chờ code khác, thử dùng code này xem
Option Explicit

Sub DemSoLoiHinhAnhVaNgoaiQuan()
Dim ws As Worksheet
Dim lastRow As Long
Dim productCodeRange As Range
Dim productCodeCell As Range
Dim productCode As String
Dim errorImageCount As Integer
Dim errorExternalCount As Integer

Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

Set productCodeRange = ws.Range("J1:J" & lastRow)
For Each productCodeCell In productCodeRange
productCode = productCodeCell.Value
errorImageCount = 0
errorExternalCount = 0
For i = 1 To lastRow

If ws.Cells(i, "D").Value = productCode Then

errorImageCount = errorImageCount + ws.Cells(i, "E").Value

errorExternalCount = errorExternalCount + ws.Cells(i, "F").Value
End If
Next i

productCodeCell.Offset(0, 2).Value = errorImageCount
productCodeCell.Offset(0, 3).Value = errorExternalCount
Next productCodeCell
End Sub

Nên để như thế này cho gọn.

Mã:

Option Explicit
Sub DemSoLoiHinhAnhVaNgoaiQuan()
Dim ws As Worksheet
Dim lastRow As Long
Dim productCodeRange As Range
Dim productCodeCell As Range
Dim productCode As String
Dim errorImageCount As Integer
Dim errorExternalCount As Integer
Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
Set productCodeRange = ws.Range("J1:J" & lastRow)
For Each productCodeCell In productCodeRange
productCode = productCodeCell.Value
errorImageCount = 0
errorExternalCount = 0
For i = 1 To lastRow
If ws.Cells(i, "D").Value = productCode Then
errorImageCount = errorImageCount + ws.Cells(i, "E").Value
errorExternalCount = errorExternalCount + ws.Cells(i, "F").Value
End If
Next i
productCodeCell.Offset(0, 2).Value = errorImageCount
productCodeCell.Offset(0, 3).Value = errorExternalCount
Next productCodeCell
End Sub

dungluyen2119 · 11/4/23

Hoàng Tuấn 868 đã viết:

Nên để như thế này cho gọn.

Mã:

Option Explicit
Sub DemSoLoiHinhAnhVaNgoaiQuan()
Dim ws As Worksheet
Dim lastRow As Long
Dim productCodeRange As Range
Dim productCodeCell As Range
Dim productCode As String
Dim errorImageCount As Integer
Dim errorExternalCount As Integer
Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
Set productCodeRange = ws.Range("J1:J" & lastRow)
For Each productCodeCell In productCodeRange
productCode = productCodeCell.Value
errorImageCount = 0
errorExternalCount = 0
For i = 1 To lastRow
If ws.Cells(i, "D").Value = productCode Then
errorImageCount = errorImageCount + ws.Cells(i, "E").Value
errorExternalCount = errorExternalCount + ws.Cells(i, "F").Value
End If
Next i
productCodeCell.Offset(0, 2).Value = errorImageCount
productCodeCell.Offset(0, 3).Value = errorExternalCount
Next productCodeCell
End Sub

Bác ơi, sao em code vào nào bị lỗi nhỉ, Bác có thể gán vào file e gửi rồi xem giúp e được không. cảm ơn bác nhiều

Hoàng Tuấn 868 · 11/4/23

dungluyen2119 đã viết:
Bác ơi, sao em code vào nào bị lỗi nhỉ, Bác có thể gán vào file e gửi rồi xem giúp e được không. cảm ơn bác nhiều

Thông cảm nhé, mình không hỗ trợ các trường hợp viết tắt.

BuiQuangThuan · 11/4/23

Hoàng Tuấn 868 đã viết:
Thông cảm nhé, mình không hỗ trợ các trường hợp viết tắt.

Thấy bạn ấy đã sửa bài viết. Hihi

dungluyen2119 đã viết:
Thưa các Bác. Chả là e đang tổng hợp dữ liệu báo cáo cho công ty mà dữ liệu lên đến cả trăm nghìn sản phẩm. Không thể dùng hàm Countifs để đếm được vì file nặng và chậm. Em kính mong các Bác giúp em code VBA để giải quyết bài toán này. Đếm số lượng lỗi của 1 sản phẩm theo hiện trạng lỗi. Em có gửi file đính kèm. các bác giúp em vói ạ. em xin cảm ơn!

Bạn có thể tham khảo code sau

Mã:

Sub Countif_VBA()
    Dim Dic As Object, sArr(), Res(), i&, Key, iRow&, m&, k&, j&
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        iRow = .Range("D" & Rows.Count).End(3).Row
        sArr = .Range("C5:G" & iRow).Value
        ReDim Res(1 To UBound(sArr), 1 To 7)
        For i = 1 To UBound(sArr)
            Key = sArr(i, 2) & "|" & sArr(i, 3)
            If Dic.exists(Key) = False Then
                k = k + 1
                Dic.Add Key, k
                Res(k, 1) = k: Res(k, 2) = Split(Key, "|")(0)
                Res(k, 3) = Split(Key, "|")(1)
                For j = 4 To 5
                    If sArr(i, j) <> Empty Then
                        Res(k, j) = Res(k, j) + 1
                        
                    End If
                Next
                Res(k, 6) = Res(k, 4) / CLng(Split(Key, "|")(1))
                Res(k, 7) = Res(k, 5) / CLng(Split(Key, "|")(1))
            Else
                m = Dic.Item(Key)
                For j = 4 To 5
                    If sArr(i, j) <> Empty Then
                        Res(m, j) = Res(m, j) + 1
                    End If
                Next
                Res(m, 6) = Res(m, 4) / CLng(Split(Key, "|")(1))
                Res(m, 7) = Res(m, 5) / CLng(Split(Key, "|")(1))
            End If
        Next
        If k > 0 Then
        .Range("J15").Resize(10000, 7).ClearContents
        .Range("J15").Resize(k, 7).Value = Res
        End If
    End With
End Sub

Sonkull · 11/4/23

dungluyen2119 đã viết:
Thưa các Bác. Chả là e đang tổng hợp dữ liệu báo cáo cho công ty mà dữ liệu lên đến cả trăm nghìn sản phẩm. Không thể dùng hàm Countifs để đếm được vì file nặng và chậm. Em kính mong các Bác giúp em code VBA để giải quyết bài toán này. Đếm số lượng lỗi của 1 sản phẩm theo hiện trạng lỗi. Em có gửi file đính kèm. các bác giúp em vói ạ. em xin cảm ơn!View attachment 288801

Option Explicit

Sub test()
Dim Source, SQL_Command As String
Source = ThisWorkbook.FullName
SQL_Command = "SELECT [Ma_san_pham], COUNT(hinh_anh) as Hinh_anh , COUNT(ngoai_quan) as Ngoai_Quan FROM [data$] GROUP BY [Ma_san_pham] ORDER BY [Ma_san_pham] ASC"
SQL_QUERY Source, SQL_Command, SHEET_data, "G1"
End Sub
Góp vui vs mọi người

VetMini · 11/4/23

dungluyen2119 đã viết:
Em đã nghĩ tới, cơ mà sếp em khó tính anh ạ ((
...

Khó tính mà có chấp nhận bạn dùng từ "e" trong email không? Khoan nói đến báo cáo.

bebo021999 · 12/4/23

Dùng tạm:

PHP:

Option Explicit
Sub count_If()
Dim lr&, i&, j&, k&, rng, ha&, nq&, res(1 To 10000, 1 To 4)
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, "D").End(xlUp).Row
rng = Range("D5:F" & lr).Value
For i = 1 To UBound(rng)
    ha = IIf(rng(i, 2) = "", 0, 1): nq = IIf(rng(i, 3) = "", 0, 1)
    If Not dic.exists(rng(i, 1)) Then
        dic.Add rng(i, 1), ha & "|" & nq
        k = k + 1: res(k, 1) = k: res(k, 2) = rng(i, 1): res(k, 3) = ha: res(k, 4) = nq
    Else
        dic(rng(i, 1)) = Split(dic(rng(i, 1)), "|")(0) + ha & "|" & _
        Split(dic(rng(i, 1)), "|")(1) + nq
        For j = 1 To k
            If res(j, 2) = rng(i, 1) Then
                res(j, 3) = res(j, 3) + ha: res(j, 4) = res(j, 4) + nq
            End If
        Next
    End If
Next
'Dan ket qua vào vùng I15
Range("I15:L10000").ClearContents
Range("I15").Resize(dic.Count, 4).Value = res
End Sub

Code VBA thay thế hàm Countifs (3 người xem)

Người dùng đang xem chủ đề này

Thành viên mới

File đính kèm

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

Thành viên mới

Thành viên hoạt động

Thành viên mới

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

Thành viên mới

Thành viên mới

Thành viên mới

Đăng ký hôm qua

Thành viên mới

Đăng ký hôm qua

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

Thành viên mới

File đính kèm

Ăn cùng góc phố

Thành viên gạo cội

File đính kèm

Đếm ngược thời gian