Nhờ các bác code tô mầu tiết trống

[aviaiva]

Nhờ các bác viết hộ code vba tô màu tiết trống

 

[dhn46]

Sao bạn không dùng Condition Formatting?
Điều kiện là

=B3=""

 

[aviaiva]

Sao bạn không dùng Condition Formatting?
Điều kiện là

=B3=""

đâu có đơn giản thế bác nó còn phụ thuộc vào tiết phía sau có hay không nữa mà, VD ngày có 6 tiết nếu tiết 1,2,3 kín các tiết còn lại không coi là tiết trống. nhưng nếu tiết 1 kín, hoặc tiết 1,2 kín các tiết còn lại sẽ là tiết trống

 

[nghiaphuc]

đâu có đơn giản thế bác nó còn phụ thuộc vào tiết phía sau có hay không nữa mà, VD ngày có 6 tiết nếu tiết 1,2,3 kín các tiết còn lại không coi là tiết trống. nhưng nếu tiết 1 kín, hoặc tiết 1,2 kín các tiết còn lại sẽ là tiết trống

Đồng nghiệp xài tạm code này nhé:
[GPECODE=vb]Sub ToMau()
Dim Rng As Range, Cll As Range, Cll1 As Range
On Error Resume Next
Sheet1.[B2].CurrentRegion.Interior.Pattern = xlNone
Set Rng = Sheet1.[B3:H8]
Do While Rng(1, 1) <> ""
For Each Cll In Rng.SpecialCells(4)
Set Cll1 = Intersect(Cll.Resize(6), Rng).Find("*")
If Not Cll1 Is Nothing Then Cll.Interior.ColorIndex = 4
Next
Set Rng = Rng.Offset(6)
Loop
End Sub[/GPECODE]

 

[aviaiva]

Em cảm ơn ạ!
em cũng làm được nhưng toàn if với then code dài quá

 

[chuot0106]

Nhờ các bác viết hộ code vba tô màu tiết trống

Chắc đây là phần mềm hỗ trợ xếp TKB thì phải. Mình đã từng đọc chủ đề này của bạn rất hay. Cảm ơn bạn.

 

[aviaiva]

Đồng nghiệp xài tạm code này nhé:
[GPECODE=vb]Sub ToMau()
Dim Rng As Range, Cll As Range, Cll1 As Range
On Error Resume Next
Sheet1.[B2].CurrentRegion.Interior.Pattern = xlNone
Set Rng = Sheet1.[B3:H8]
Do While Rng(1, 1) <> ""
For Each Cll In Rng.SpecialCells(4)
Set Cll1 = Intersect(Cll.Resize(6), Rng).Find("*")
If Not Cll1 Is Nothing Then Cll.Interior.ColorIndex = 4
Next
Set Rng = Rng.Offset(6)
Loop
End Sub[/GPECODE]

trong trường hợp nó đổi thành hàng dọc thì thay đổi code thế nào, bác giúp em nốt

 

[nghiaphuc]

trong trường hợp nó đổi thành hàng dọc thì thay đổi code thế nào, bác giúp em nốt

Thế thì sửa lại một chút chứ mấy đâu:
[GPECODE=vb]Sub ToMau_Doc()
Dim Rng As Range, Cll As Range, Cll1 As Range
On Error Resume Next
Sheet3.[B2].CurrentRegion.Interior.Pattern = xlNone
Set Rng = Sheet3.[E3:J7]
Do While Rng(1, 1) <> ""
For Each Cll In Rng.SpecialCells(4)
Set Cll1 = Intersect(Cll.Resize(, 6), Rng).Find("*")
If Not Cll1 Is Nothing Then Cll.Interior.ColorIndex = 4
Next
Set Rng = Rng.Offset(, 6)
Loop
End Sub[/GPECODE]
Nói thêm một chút: Sử dụng phương thức Find và SpecialCells này cũng có cái hay và thú vị, nó đỡ rất nhiều so với việc sử dụng For để duyệt hết toàn bảng. Và trong code trên, nếu không có dòng On Error Resume Next thì code "tèo", do đó việc sử dụng câu lệnh này cũng rất tốt nếu ta kiểm soát được lỗi có thể phát sinh trong quá trình chạy code.

 

[le phuong van]

Tô màu ô trống

đâu có đơn giản thế bác nó còn phụ thuộc vào tiết phía sau có hay không nữa mà, VD ngày có 6 tiết nếu tiết 1,2,3 kín các tiết còn lại không coi là tiết trống. nhưng nếu tiết 1 kín, hoặc tiết 1,2 kín các tiết còn lại sẽ là tiết trống

Làm như thế này thì không bị như aviaiva:
Quét chọn vùng C3->G38, Chọn Format, chọn Format Condition, bấm vào dấu tam giác chọn: This is, gõ vào khung trống công thức:
=counta(C3)=0
Chọn Format (bên phải), chọn thẻ Patterns, chọn màu nền tùy thích, Ok, Ok tiếp.

 

[nghiaphuc]

Làm như thế này thì không bị như aviaiva:
Quét chọn vùng C3->G38, Chọn Format, chọn Format Condition, bấm vào dấu tam giác chọn: This is, gõ vào khung trống công thức:
=counta(C3)=0
Chọn Format (bên phải), chọn thẻ Patterns, chọn màu nền tùy thích, Ok, Ok tiếp.

Làm như vậy không đúng với yêu cầu của tác giả thầy à. Cụ thể là các vùng G13:G14, F18:F20, E23:E26 không được xem là tiết trống nhưng vẫn bị tô màu.

 

[nghiaphuc]

Xin góp vui thêm một cách sử dụng Conditional Formatting:
Quét chọn vùng C3:G38 và sử dụng công thức sau cho CF:

=AND($B3<6,C3="",COUNTA(OFFSET(C3,1,0,6-$B3))>0)