Tìm ô trống rồi thông báo và tô màu (1 người xem)

[AnhThu-1976]

Em chào các anh chị!
Do số lượng các dòng trên 1 bảng tính rất là nhiều nếu sử dụng Conditional Fommatting
thì File sẽ nặng thêm (do trên file còn nhiều công thức)
Em muốn các anh chị viết em 1 code để kiểm tra cột D (bắt đầu từ ô D9 xuống dưới) nếu ô nào trống thì tô màu đỏ đồng thời thông báo địa chỉ ô trống = Msg
Trong File các ô trống là D1416, D19
Em cảm ơn
P/S: Các cột khác nếu có trống thì không quan tâm

 

[leonguyenz]

Duyệt từng ô, xét điều kiện (ô trống) rồi tô màu: như vậy còn chậm hơn CF.
Bạn định giới hạn số dòng là bao nhiêu?

 

[Ba Tê]

Em chào các anh chị!
Do số lượng các dòng trên 1 bảng tính rất là nhiều nếu sử dụng Conditional Fommatting
thì File sẽ nặng thêm (do trên file còn nhiều công thức)
Em muốn các anh chị viết em 1 code để kiểm tra cột D (bắt đầu từ ô D9 xuống dưới) nếu ô nào trống thì tô màu đỏ đồng thời thông báo địa chỉ ô trống = Msg
Trong File các ô trống là D1416, D19
Em cảm ơn
P/S: Các cột khác nếu có trống thì không quan tâm

Nhìn màu được rồi, Msgbox làm gì, Nếu muốn thì tự thêm vào nhé.

Public Sub GPE()
Dim Cll As Range
Range([D9], [D65536].End(xlUp)).Interior.ColorIndex = 0
For Each Cll In Range([D9], [D65536].End(xlUp))
    If Cll.Value = Empty Then
        Cll.Interior.ColorIndex = 3
    End If
Next Cll
End Sub

 

[AnhThu-1976]

Duyệt từng ô, xét điều kiện (ô trống) rồi tô màu: như vậy còn chậm hơn CF.
Bạn định giới hạn số dòng là bao nhiêu?

File thực tế khoảng 50.000 dòng trở lên bạn ạ

 

[phulien1902]

Xin góp 1 code

Sub ToMauCell()
    Dim cell As Range
    Dim myRange As Range
    Set myRange = Range("D9:D65000")
    myRange.Interior.ColorIndex = 2
    Application.ScreenUpdating = False
    For Each cell In myRange
        If Len(cell) = 0 Then
            cell.Interior.ColorIndex = 6
        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[doveandrose]

Xin góp 1 code

Sub ToMauCell()
    Dim cell As Range
    Dim myRange As Range
    Set myRange = Range("D9:D65000")
    myRange.Interior.ColorIndex = 2
    Application.ScreenUpdating = False
    For Each cell In myRange
        If Len(cell) = 0 Then
            cell.Interior.ColorIndex = 6
        End If
    Next
    Application.ScreenUpdating = True
End Sub

ẹc ở trên đã có bài rồi mà . bạn viết sau cũng nên kiếm cái gì mới mới chút coi mới sinh động chứ . bài trên người ta đã cảnh báo là 50000 dòng rồi còn đi duyệt từng cell . thử không xài vòng lặp cho mới mẻ thử coi nào

 

[giangleloi]

ẹc ở trên đã có bài rồi mà . bạn viết sau cũng nên kiếm cái gì mới mới chút coi mới sinh động chứ . bài trên người ta đã cảnh báo là 50000 dòng rồi còn đi duyệt từng cell . thử không xài vòng lặp cho mới mẻ thử coi nào

Không xài vòng lặp thì bác "chim hồng" ra tay luôn đi. Đánh đố quá, hại não lắm

 

[ChanhTQ@]

Như file tác gia đưa ra thì có vẻ như số dòng trống là ít;

Option Explicit
Sub ToMauNhungODangTrong()
 Dim Rng As Range, Cls As Range
 
 Sheets("GPE").Select
 Set Rng = Range([D1], Cells(Cells.Rows.Count, "D").End(xlUp)).SpecialCells(xlCellTypeBlanks)
 For Each Cls In Rng
    Cls.Interior.ColorIndex = 35 + Cls.Row Mod 2
 Next Cls
End Sub

 

[doveandrose]

Không xài vòng lặp thì bác "chim hồng" ra tay luôn đi. Đánh đố quá, hại não lắm

mình tâm sự với Phulien mà các vị anh hùng cứ vào trêu chọc . hổng chịu đâu . hức

 

[phulien1902]

ẹc ở trên đã có bài rồi mà . bạn viết sau cũng nên kiếm cái gì mới mới chút coi mới sinh động chứ . bài trên người ta đã cảnh báo là 50000 dòng rồi còn đi duyệt từng cell . thử không xài vòng lặp cho mới mẻ thử coi nào

Rất cảm ơn bạn đã góp ý!
Theo tôi khi 1 vấn đề vướng mắc được đưa ra, nếu có nhiều hướng giải quyết dù hay dù dở vẫn cứ hay chứ sao ?. Hơn nữa tôi cũng đang chập chững đến với VBA mà.

 

[thangbithu]

Nhờ các anh chị chỉ và giải thích giùm, tại sao đoạn code sau bị sai ở dòng tô màu?

Sub Tomau()
Dim Arr1()
Dim DongCuoi As Long
DongCuoi = Range("a100000").End(xlUp).Row
Arr1 = Range("a1:a" & DongCuoi).Value
For i = 1 To DongCuoi
If Arr1(i, 1) = Empty Then
Arr1(i, 1).Interior.ColorIndex = 3
End If
Next i
End Sub

 

[giangleloi]

Nhờ các anh chị chỉ và giải thích giùm, tại sao đoạn code sau bị sai ở dòng tô màu?

Sub Tomau()
Dim Arr1()
Dim DongCuoi As Long
DongCuoi = Range("a100000").End(xlUp).Row
Arr1 = Range("a1:a" & DongCuoi).Value
For i = 1 To DongCuoi
If Arr1(i, 1) = Empty Then
Arr1(i, 1).Interior.ColorIndex = 3
End If
Next i
End Sub

Nghe đồn phải xem kỹ lại cách dùng mảng ấy bạn.

 

[SA_DQ]

Nhờ các anh chị chỉ và giải thích giùm, tại sao đoạn code sau bị sai ở dòng tô màu?
Arr1(i, 1).Interior.ColorIndex = 3

https://msdn.microsoft.com/en-us/library/office/ff840499.aspx

 

[thangbithu]

Bạn đang khai báo Arr1(): là mãng chứ không phải Range
Trong khi dòng dưới là Arr1(i, 1).Interior.ColorIndex = 3. Chỗ này chắc bạn hiểu nó là Range nên mới viết như vậy

=> Bức râu ông nọ cắm cằm bà kia. Chắc là hok có được rồi.
Thử khai báo cho nó (Arr1) là Range luôn đi, sẽ không chết thằng Tây nào hết á.

Sub Tomau()
Dim Arr1 As Range
Dim DongCuoi As Long
DongCuoi = Range("a100000").End(xlUp).Row
Set Arr1 = Range("a1:a" & DongCuoi)
For i = 1 To DongCuoi
If Arr1(i, 1) = Empty Then
Arr1(i, 1).Interior.ColorIndex = 3
End If
Next i
End Sub

Cảm ơn bạn nhiều.
Trong trường hợp vẫn cố tình dùng mảng thì phải viết như thế nào ạ?

 

[AnhThu-1976]

Thì phải xét Cells trong vùng mảng đó, nếu thỏa thì tô màu....

Sub ToMau()
Dim Arr1()
Dim DongCuoi As Long
DongCuoi = Range("a100000").End(xlUp).Row
Arr1 = Range("a1:a" & DongCuoi)
For i = 1 To [COLOR=#ff0000][B]UBound(Arr1)[/B][/COLOR]
If Arr1(i, 1) = Empty Then
[B][COLOR=#ff0000]Cells[/COLOR][/B](i, 1).Interior.ColorIndex = 3
End If
Next i
End Sub

Tôi có áp dụng bài này vào thực tế
Cột áp dụng cột AB
Dòng áp dụng từ dòng thứ 9 trở xuống
Tôi sửa code như sau

Sub TToMau()
    Dim Arr1()
    Dim DongCuoi As Long
    Dim i
    DongCuoi = Range("AB50000").End(xlUp).Row
    Arr1 = Range("AB8:AB" & DongCuoi)
    For i = 1 To UBound(Arr1)
        If Arr1(i + 8, 28) = Empty Then
            Cells(i + 8, 28).Interior.ColorIndex = 3
        End If
    Next i


End Sub

Thì nó báo lỗi Subsript out of range
Nhờ các bạn xem lỗi chỗ nào? Xin cảm ơn

 

[AnhThu-1976]

Tôi có áp dụng bài này vào thực tế
Cột áp dụng cột AB
Dòng áp dụng từ dòng thứ 9 trở xuống
Tôi sửa code như sau

Sub TToMau()
    Dim Arr1()
    Dim DongCuoi As Long
    Dim i
    DongCuoi = Range("AB50000").End(xlUp).Row
    Arr1 = Range("AB[COLOR=#ff0000]9[/COLOR]:AB" & DongCuoi)
    For i = 1 To UBound(Arr1)
        If Arr1([B][COLOR=#ff0000]i[/COLOR][/B] , 28) = Empty Then
            Cells(i + 8, 28).Interior.ColorIndex = 3
        End If
    Next i


End Sub

Thì nó báo lỗi Subsript out of range
Nhờ các bạn xem lỗi chỗ nào? Xin cảm ơn

Đã tìm đươc chỗ sai (màu đỏ)