Hỏi. Tô màu cho ô với điều kiện

[xda1811]

Mong các anh bớt chút thời gian nghĩ giùm em. em mới tham gia diễn đàn kiến thức còn hạn hẹp, mà công việc của em cần đến excel quá, kiến thức về VBA,macro thì em không có . Các sư huynh làm giúp em cái tool này với
em gửi file đính kèm
em muốn như sau :
1. tính theo cột giả sử là cột V trong file đính kèm
tính từ ô V5 đến V17 nếu toàn là ký tự * thì sẽ có màu xanh ( Nếu từ 8 đến 15 ô liên tiếp nhau là ký tự * thì được bôi màu xanh )
2. tương tự cột T
tính từ ô T24 đến T43
liên tiếp là dấu * em muốn là màu tím than ( Nếu từ 16 đến 25 ô liên tiếp nhau là ký tự * thì được bôi màu màu tím than )
3.tương tự với cột M
tính từ ô M11 đến M35 liên tiếp là dấu * em muốn là màu nâu ( Nếu từ 26 đến 40 ô liên tiếp nhau là ký tự * thì được bôi màu nâu )

Mong các anh hướng dẫn cụ thể, chi tiết cho em
Cảm ơn các sư huynh, chúc các sư huynh luôn mạnh khỏe

 

[tuanminhtdhbthn]

Mình chưa hiểu ý bạn. Nhưng bạn thử xem file mình giải ở dưới có đúng không? Chỉ dùng CF thôi, không dùng VBA

 

[tuananhtg]

Bạn lick vào ô muốn tạo điều kiện. Chọn Format --> Conditional Formating...
Sau đó kéo thả ô đó xuống các ô muốn gán điều kiện.

Cụ thể:
Chọn cột V5--vào Format--Conditional formating...
Bảng Conditional formating hiện ra: Tại conditional 1.
Chọn cell value is
Chọn Equal to
Ô trống bạn type vào: ="*"
Bạn thấy Command button "Format" Lick vào.
Hiện ra cửa sổ format cell.
Lúc này bạn muốn tô màu gì tùy bạn.

À quên: nếu muốn tạo thêm một điều kiện nào đó bạn lick nút "Add>>".
Ứng với một điều kiện sẽ cho kiểu format cell.

 

[ptm0412]

Làm theo tuananh và tuanminh sẽ tô tất cả ô có giá trị "*", chưa có điều kiện số lượng ô phải lớn hơn 1 số cho trước.

File dưới đây dùng VBA, làm vội nên chưa gọn gàng gì.

 

[SA_DQ]

Thêm 1 tham khảo đây, xin mời

Option Explicit
Sub ToMau()
 Const DS As String = "*":                  Dim Color_ As String
 Dim Cols As Byte, zZ As Byte, dSao As Byte
 Dim Rws As Long, Ff As Long
 
 Cols = [iV2].End(xlToLeft).Column
 Rws = [A65500].End(xlUp).Row:              [b2].CurrentRegion.ClearFormats
 For zZ = 1 To Cols
    dSao = 0
    For Ff = 1 To Rws
        With Cells(Ff, zZ)
            If .Value = DS And dSao = 0 Then
                dSao = 1
            ElseIf .Value = DS And dSao > 0 Then
                dSao = dSao + 1
            ElseIf .Value <> DS And dSao > 7 Then
                Select Case dSao
                Case Is < 16
                    Color_ = "X"
                Case Is < 26
                    Color_ = "T"
                Case Is < 41
                    Color_ = "N"
                End Select
                Color .Offset(-dSao).Resize(dSao), Color_
                dSao = 0
            ElseIf .Value <> DS And dSao < 8 Then
                dSao = 0
            End If
        End With
        
    Next Ff
 Next zZ
End Sub

[B]Sub Color(Rng As Range, Color_ As String)[/B]
 With Rng.Interior
    Select Case UCase$(Color_)
    Case "T"
        .ColorIndex = 13    '16-25
    Case "N"
        .ColorIndex = 54
    Case "X"
        .ColorIndex = 42    '8-15
    Case Else
        .ColorIndex = 0     '26-40
    End Select
    .Pattern = xlSolid
 End With
    
[B]End Sub[/B]

 

[ptm0412]

Đã làm gọn rồi, tùy biến cao hơn:
1 code duy nhất, mỗi cột chạy 1 lần, muốn chọn bao nhiêu cột cũng được, chỉ cần điền tham số vào cho code chạy bấy nhiêu lần:
Cấu trúc câu lệnh:

ColorFill tên cột, từ dòng, đến dòng, số ô tối thiểu, mã màu từ 1 đến 56

[highlight=vb]Private Sub Cmb1_Click()
Cells().Interior.ColorIndex = xlNone
ColorFill "M", 11, 35, 24, 4
ColorFill "T", 24, 43, 16, 26
ColorFill "V", 5, 17, 8, 36
End Sub[/highlight]

[highlight=vb]Sub ColorFill (Cot As String, Dong1 As Long, Dong2 As Long, Num1 As Long, ColorCode As Long)
k = 0
For j = Dong1 To Dong2
If Trim(Range(Cot & j)) = Chr(42) Then k = k + 1
If (k <= Num1 - 1 And k > 0 And Trim(Range(Cot & j)) <> Chr(42)) Then k = 0
If k > Num1 - 1 And Trim(Range(Cot & j)) <> Chr(42) Then
Range(Cot & j - k, Cot & j - 1).Interior.ColorIndex = ColorCode: k = 0
End If
Next j
End Sub[/highlight]

 

[ChanhTQ@]

em muốn như sau :
3.tương tự với cột M
tính từ ô M11 đến M35 liên tiếp là dấu * em muốn là màu nâu ( Nếu từ 26 đến 40 ô liên tiếp nhau là ký tự * thì được bôi màu nâu )
Mong các anh hướng dẫn cụ thể, chi tiết cho em
Cảm ơn các sư huynh, chúc các sư huynh luôn mạnh khỏe

Đếm lại coi sao bạn thân mến; Mình làm hoài mà thấy thỏa điều kiện 26 đến 40 ô đâu;
Hình như trong các ô đã dùng không có thỏa điều kiện thứ ba này thì phải.
Bạn chưa nghiêm chỉnh đó nghe!

Chúc thắng lợi!

 

[xda1811]

Em cảm ơn anh SA_DQ . em mới học về excel anh ạ . mong anh hướng dẫn cụ thể giúp em. như em hiểu thì copy đoạn code của anh . sau đó vào menu tools\Macro\visual basic ..\ paste đoạn code của anh vào phải không ạ
mong các anh chỉ dạy em cụ thể nha. em mới bập bẹ về excel
Chúc các anh khỏe mạnh và thành đạt

 

[ptm0412]

Anh hướng dẫn cụ thể dùm em với, em kém kiến thức về tin lắm

Code nguyên thủy là thế này:

Private Sub Cmb1_Click()
Cells().Interior.ColorIndex = xlNone
ColorFill "M", 11, 35, 24, 4
ColorFill "T", 24, 43, 16, 26
ColorFill "V", 5, 17, 8, 36
End Sub

Bây giờ giả sử em muốn làm cột X, từ dòng 5 đến dòng 57, hễ mà có 10 dấu * liên tục trở lên là tô màu, thì thêm câu này vào:

ColorFill "X", 5, 57, 10, 20

Nếu muốn làm thêm cột B từ dòng 10 đến dòng 30, tối thiểu là 5 dấu * liên tục thì tô màu, thì thêm dòng này vào:

ColorFill "B", 10, 30, 5, 20

À, em tải lại file tomaucot2.zip nha, có thêm 1 câu lệnh để phòng xa lỡ mà trên cùng cột mà có 2 vùng thỏa điều kiện trở lên thì tô cả các vùng.

20 là mã màu, em không thích màu đó thì đổi số khác, trong phạm vi từ 1 đến 56. Muốn biết mỗi số tương ứng với màu gì thì có thể dùng code để biết, nhưng không chỉ cho em được, (vì không dạy người yếu đánh vật). Từ từ khi nào em khá sẽ tự biết.

Còn nữa nè: cái mà Bác Sa nói, nghĩa là vầy: Cột M từ dòng 11 đến 35, chỉ có vừa đúng 25 ô, thì làm sao mà có cái vụ từ 26 đến 40? may ra thì có 25!!!

NGHĨA LÀ KHI THÊM DÒNG LỆNH NHƯ TRÊN, SỐ Ố DÙNG LÀM ĐIỀU KIỆN PHẢI NHỎ HƠN HOẶC BẰNG TỔNG SỐ Ô.

 

[xda1811]

vâng. em down file của anh về rồi ạ.
- Em làm như anh hướng dẫn, cột J em thêm dòng này colorfill "J", 1, 57, 16, 26
sau đó em kiểm tra thì excel bôi màu tím từ J10 đến J54 (mà J54,j47,43 đều là số không phải là ký tự * )
- File dữ liệu đầy đủ của em > 2.5mb không biết em có upload được lên không.
- Mong anh giúp em
EM cảm ơn nhiều . mong anh giúp đỡ em

 

[ChanhTQ@]

Mình làm giúp bạn 1 lần đây

Vâng. trước hết em cảm ơn các anh nhiều lắm
do sơ suất em ko để cột từ M11 đến M35. ở file em post là em trích dữ liệu anh ạ, em sửa lại rồi.
P/S : anh dùm em với, em kém kiến thức về tin lắm
Em cảm ơn các anh, chúc các anh thành đạt

Đã chuyển macro sang dữ liệu thực của bạn, bạn vô cửa sổ VBE xem chúng như thế nào nha (File đính kèm do bạn đã cập nhật đó!)
Mong rằng bạn sẽ biết chép vô đúng ngăn cần thiết lúc khác bạn muốn.

 

[Po_Pikachu]

Bạn xem file đây!
Thân.

 

[ptm0412]

Thanks PoPikachu.
Nhưng còn 1 sai sót là nếu vừa đúng hết Dong2 mà vẫn còn dấu * và đủ điều kiện thì nó không tô. Bây giờ thì có.

 

[xda1811]

Thanks PoPikachu.
Nhưng còn 1 sai sót là nếu vừa đúng hết Dong2 mà vẫn còn dấu * và đủ điều kiện thì nó không tô. Bây giờ thì có.

Đa tạ sư huynh nhiều lắm. em muốn hỏi thêm anh 1 chút.
Giả sử từ J1 đến dòng J1508. các cột khác tương tự như cộ J này
- từ 8 đến 15 ô là * liên tiếp: màu 1
- từ 16 đến 25 ô là * liên tiếp: màu 2
- từ 26 đến 50 ô là * liên tiếp (tối đa): màu 3

mong anh giúp em
Cái buttom DO anh vẽ ko đc xoá đi hả anh ?

 

[ptm0412]

Có rồi đây. 3 màu tùy chọn,
Nút nhấn DO đã delete, muốn chạy code thì nhấn Ctrol + t

 

[xda1811]

Có rồi đây. 3 màu tùy chọn,
Nút nhấn DO đã delete, muốn chạy code thì nhấn Ctrol + t

em làm được rồi. đúng ý tưởng của em
Đa tạ sư phụ nhiều lắm ạ, thật không thể tưởng tượng nổi, sự kỳ diệu của excel
Đa tạ sư phụ

 

[xda1811]

Có rồi đây. 3 màu tùy chọn,
Nút nhấn DO đã delete, muốn chạy code thì nhấn Ctrol + t

anh ptm0412 sửa code dùm em

anh thêm cho em vào đoạn code cái hàm đếm với. VD tại cột A8 đến A16 sau khi bôi màu xong thì nó báo luôn tổng số ô có dấu *là 9
cảm ơn anh ạ

 

[ptm0412]

1. Sửa câu Check = Trim(Cells(j, i))
thành Check = Left(Trim(Cells(j, i)), 1)

2. Thêm 1 câu:
Cells(j - 1, i) = Cells(j - 1, i) & k

vào 2 chỗ.

Sub ColorFill(Color1 As Long, Color2 As Long, Color3 As Long)
Application.ScreenUpdating = False
Sheet2.Cells(1, 3) = Timer
EndCol = Range("IV1").End(xlToLeft).Column
EndRow = Range("A65536").End(xlUp).Row
For i = 1 To EndCol
    k = 0
    For j = 1 To EndRow
        If Cells(j, i).Interior.ColorIndex <> 3 Then Cells(j, i).Interior.ColorIndex = xlNone
        Check = Left(Trim(Cells(j, i)), 1)
        If Check = Chr(42) Then k = k + 1
        If k < 8 And Check <> Chr(42) Then k = 0
        If k >= 8 And Check <> Chr(42) Then
            Select Case k
            Case 8 To 15
                ColorCode = Color1
            Case 16 To 25
                ColorCode = Color2
            Case Is > 15
                ColorCode = Color3
            End Select
            Range(Cells(j - k, i), Cells(j - 1, i)).Interior.ColorIndex = ColorCode
            Cells(j - 1, i) = Chr(42) & k
            k = 0
        End If
        If k >= 8 And j = EndRow And Check = Chr(42) Then
            Range(Cells(j - k + 1, i), Cells(j, i)).Interior.ColorIndex = ColorCode
            Cells(j, i) = Chr(42) & k
            k = 0
        End If
   Next j
Next i
Sheet2.Cells(2, 3) = Timer
Application.ScreenUpdating = True
End Sub

Kết quả :

Ghi chú: thêm con số nhưng vẫn phải để dấu * đề phòng chạy code lần 2, lần 3 kết quả như cũ, nếu không, sau mỗi lần chạy con số bị giảm xuống 1.

 

[xda1811]

anh ơi ! sao ở hàng thứ 15xx nó cứ hiện *88/ *99 thế hả anh ?

 

[ptm0412]

Biết rồi, chạy lần 1 thì ra *8, lần 2 thì ra *88, lần 3 thì *888
Đã sửa lại code ở bài trên:

câu Cells(j - 1, i) = Cells(j - 1, i) & k

sửa thành

Cells(j - 1, i) = chr(42) & k