Code VBA thay thế hàm Countifs

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
dungluyen2119

dungluyen2119

Thành viên mới
Tham gia
24/3/23
Bài viết
11
Được thích
3
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!Cap 22.PNG
 

File đính kèm

  • Xin code VBA thay thế hàm Countifs đếm lỗi SP.xlsx
    9.5 KB · Đọc: 19
Lần chỉnh sửa cuối:
BuiQuangThuan đã viết:
Sao lại từ chối hàm của bác Bill thế bạn
Nhấp chuột vào đây để mở rộng...
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:

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é
Nhấp chuột vào đây để mở rộng...
Bác có thể giúp e được không ạ
 
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
 
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
Nhấp chuột vào đây để mở rộng...
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
 
Thay vì dùng countif sao bạn không dùng pivot?
 
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
 
quangminhici đã viết:
Thay vì dùng countif sao bạn không dùng pivot?
Nhấp chuột vào đây để mở rộng...
Em đã nghĩ tới, cơ mà sếp em khó tính anh ạ :(((
Bài đã được tự động gộp:

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
Nhấp chuột vào đây để mở rộng...
Vâng, cảm ơn bác, để e thư xem ạ
 
Lần chỉnh sửa cuối:
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
 
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
Nhấp chuột vào đây để mở rộng...
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
 
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
Nhấp chuột vào đây để mở rộng...
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 đã viết:
Thông cảm nhé, mình không hỗ trợ các trường hợp viết tắt.
Nhấp chuột vào đây để mở rộng...
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!
Nhấp chuột vào đây để mở rộng...
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
 
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
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

  • Count.xlsm
    34.2 KB · Đọc: 21
Lần chỉnh sửa cuối:
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
 

File đính kèm

  • Xin code VBA thay thế hàm Countifs đếm lỗi SP.xlsm
    18.1 KB · Đọc: 22
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

H
Kết nối vba với Database host (hiện tại đang làm host web)
2
Trả lời
26
Đọc
402
nguoiconxunui
N
A
Áp dụng Chiêu số 18: Điều khiển Conditional Formating bằng checkbox.
Trả lời
7
Đọc
120
AnhThu-1976
A
H
Cách tính phép năm
Trả lời
2
Đọc
46
VetMini
V
ongke0711
  • Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
10 11 12
Trả lời
224
Đọc
18K
tuanna.bdi
T
N
  • Question
Mở từng file PDF ra in rồi đóng lại mở tiếp file khác trên cùng folder
2
Trả lời
20
Đọc
297
Tình nghĩa giang hồ
Tình nghĩa giang hồ
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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