Cách đếm ô màu trong Excel bằng VBA

Nov 20 2024

Đôi khi chúng ta sử dụng màu tô, màu phông chữ hoặc màu định dạng có điều kiện để làm nổi bật nội dung đó. Nhưng trong một số trường hợp, chúng ta sẽ cần đếm các ô màu sao cho nhanh chóng và hiệu quả. VBA là một trong những tính năng có thể giúp bạn làm việc này. Trong bài viết này, UniTrain sẽ hướng dẫn cho bạn 3 macro hữu ích để đếm các ô màu trong Excel với VBA.

Dùng mã VBA để đếm ô bằng màu tô

Đầu tiên, chúng ta sẽ tình hiểu cách đếm ô bằng cách tô màu với macro VBA. Trước tiên, người dùng sẽ tạo User Defined Function (UDF), và sau đó áp dụng như một hàm trang tính. Tên hàm là: CountCellBy_FillColor. Chúng sẽ có hai đối số – dải ô và màu ô. Hãy thực hiện theo từng bước dưới đây:

Bước 1: Nhấn Alt + F11 để mở cửa sổ VBA.

Bước 2: Chèn một module bằng cách Insert > Module.

Apply VBA to Count Cells by Fill Color In Excel

Bước 3: Nhập mã code dưới đây:

Function CountCellBy_FillColor(CellRange As Range, CellColor As Range)
Dim FillColor As Integer
Dim FillTotal As Integer
FillColor = CellColor.Interior.ColorIndex
Set rCell = CellRange
For Each rCell In CellRange
If rCell.Interior.ColorIndex = FillColor Then
FillTotal = FillTotal + 1
End If
Next rCell
CountCellBy_FillColor = FillTotal
End Function

Lúc này, bạn không cần chạy mã, chỉ cần quay lại trang tính và bạn sẽ nhận được chức năng có sẵn ở đó.

Apply VBA to Count Cells by Fill Color In Excel

Trong trường hợp này, người dùng sẽ tính màu xanh lục. Do đó, người dùng đã đặt màu mẫu vào Ô F5. Và chèn công thức sau vào ô G5.

=CountCellBy_FillColor($C$5:$D$11,F5)

Cuối cùng, nhấn Enter và bạn sẽ nhận được số lượng cho màu xanh lá cây (như hình dưới).

Chạy mã VBA để đếm ô theo màu phông chữ trong Excel

Bây giờ chúng ta sẽ tạo hàm do người dùng xác định- CountCellsBy_FontColor để đếm các ô theo màu phông chữ. Người dùng đã sửa đổi tập dữ liệu và áp dụng màu phông chữ thay vì màu tô.

Use Excel VBA to Count Cells by Font Color

Cách bước thao tác:

Bước 1: Nhấn Alt + F11 để mở cửa sổ VBA.

Bước 2: Chèn một module bằng cách Insert > Module.

Bước 3: Nhập mã code dưới đây:

Function CountCellsBy_FontColor(cell_range As Range, CellFont_color As Range) As Long
Dim FontColor As Long
Dim CurrentRange As Range
Dim FontRes As Long
Application.Volatile
FontRes = 0
FontColor = CellFont_color.Cells(1, 1).Font.Color
For Each CurrentRange In cell_range
If FontColor = CurrentRange.Font.Color Then
FontRes = FontRes + 1
End If
Next CurrentRange
CountCellsBy_FontColor = FontRes
End Function

Lúc này, bạn không cần chạy mã, chỉ cần quay lại trang tính và bạn sẽ nhận được chức năng có sẵn ở đó.

Use Excel VBA to Count Cells by Font Color

Giả sử, người dùng cần tính màu phông chữ đỏ, nên đã chèn công thức sau vào ô G5–:

=CountCellsBy_FontColor($C$5:$D$11,F5)

Cuối cùng, nhấn Enter để hoàn thành thao tác. Bạn sẽ thấy có 4 ô có màu chữ đỏ và hàm đang trả về cùng một kết quả.

Sử dụng VBA để đếm các ô có màu theo hàng trong Excel

Giả sử, tập dữ liệu có các màu được tô trong ba cột và người dùng muốn cột thứ tư trả về kết quả là 1 nếu ít nhất hai ô vẫn còn màu xanh lục trong hàng. Ngược lại, nếu không thì sẽ trả về giá trị 0. Để làm điều này, chúng ta sẽ tạo một ô khác hàm có tên Colorby_Row. Người dùng sử dụng RGB (0,200,0) cho màu xanh lục. Tuy nhiên, bạn có thể thay đổi trong các mã tùy thích.

Đây là tập dữ liệu đã sửa đổi. Người dùng đã thêm một cột khác.

Use VBA to Count Colored Cells by Row in Excel

Các bước thao tác:

Bước 1: Nhấn Alt + F11 để mở cửa sổ VBA.

Bước 2: Chèn một module bằng cách Insert > Module.

Bước 3: Nhập mã code dưới đây:

Function Colorby_Row(rowColor1 As Range, rowColor2 As Range, rowColor3 As Range) As String
Dim rowResult As String
Dim rowCounter As Integer
mColor1 = rowColor1.Interior.Color
mColor2 = rowColor2.Interior.Color
mColor3 = rowColor3.Interior.Color
green = RGB(0, 200, 0)
rowCounter = 0
If mColor1 = green Then
rowCounter = rowCounter + 1
End If
If mColor2 = green Then
rowCounter = rowCounter + 1
End If
If mColor3 = green Then
rowCounter = rowCounter + 1
End If
If rowCounter >= 2 Then
rowResult = 1
Else
rowResult = 0
End If
Colorby_Row = rowResult
End Function