Hỏi. Tô màu cho ô với điều kiện (1 người xem)

[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

 

[ChanhTQ@]

Trong nổ lực giảm thiểu thời gian

Các bạn thử xem cái con macro này tốc độ ra sao?

Option Explicit
Sub ToMau()
 Const DS As String = "*"
 Dim Cols As Byte, zZ As Byte, dSao As Byte, bColor As Variant
 Dim Rws As Long, Ff As Long:               Dim Timer_ As Double
 
 Timer_ = Timer
 Cols = [iV2].End(xlToLeft).Column:         Application.ScreenUpdating = False
 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
                .Offset(-1).Value = DS & dSao
                bColor = Switch(dSao < 16, 42, dSao < 26, 13, dSao < 41, 54)
                With .Offset(-dSao).Resize(dSao).Interior
                    .ColorIndex = bColor
                End With
                dSao = 0
            ElseIf .Value <> DS And dSao < 8 Then
                dSao = 0
            End If
        End With
    Next Ff
 Next zZ
 Cells(1, Cols + 2) = Timer - Timer_
End Sub

 

[ptm0412]

Các bạn thử xem cái con macro này tốc độ ra sao?

test trên cùng 1 máy, bác ChanhTQ ạ, của em là 4.5625 giây, của Bác là 6.265625 giây. Khổ nỗi chủ đầu tư nhà mình lại yêu cầu ô nào của họ có màu đỏ, phải giữ nguyên màu đỏ cơ. nên em phải thêm vào cái câu này:
If Cells(j, i).Interior.ColorIndex <> 3 Then Cells(j, i).Interior.ColorIndex = xlNone
Nó làm tăng thêm ít nhất là 35 giây.
Có điều chủ đầu tư nói chậm 1 chút cũng được, nên em để nguyên thế.

Còn nữa:
1. code của Bác sẽ không tô màu cuối cột, dù cho có bao nhiêu dấu sao đi nữa. Cái này em đã bị rồi.
2. Sau mỗi lần chạy, số ô đếm được của bác bị giảm đi 1, cái này em cũng đã bị.

Bác xem hình, vùng đang được chọn là vùng không tô màu, các vùng đã tô màu là vùng đã bị ngắn lại sau lần chạy thứ 9. Em nào ngắn lại chỉ còn 7 là thua luôn.

Còn code của em thì tô tuốt tuồn tuột:

 

[ptm0412]

Học Bác Chanh hàm Switch(), và sửa lỗi tô sai màu ở cuối cột

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
            ColorCode = Switch(k < 16, Color1, k < 26, Color2, k > 25, Color3)
            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
            ColorCode = Switch(k < 16, Color1, k < 26, Color2, k > 25, Color3)
            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

 

[ChanhTQ@]

Đã sửa theo góp í của PTM (#22), thời gian bị dài ra thêm

Option Explicit
Sub ToMau()
 Const DS As String = "*"
 Dim Cols As Byte, zZ As Byte, dSao As Byte, bColor As Variant
 Dim Rws As Long, Ff As Long:               Dim Timer_ As Double
 
 Timer_ = Timer
 Cols = [iV2].End(xlToLeft).Column:         Application.ScreenUpdating = False
 Rws = [A65500].End(xlUp).Row + 1:         ' [b2].CurrentRegion.ClearFormats'
 For zZ = 1 To Cols
    dSao = 0
    For Ff = 1 To Rws
        With Cells(Ff, zZ)
            If Left(.Value, 1) = DS Then    '*'
                dSao = dSao + 1
            ElseIf Left(.Value, 1) <> DS And dSao > 7 Then
                .Offset(-1).Value = DS & dSao
                bColor = Switch(dSao < 16, 42, dSao < 26, 13, dSao < 41, 54)
                With .Offset(-dSao).Resize(dSao).Interior
                    .ColorIndex = bColor
                End With
                dSao = 0
            ElseIf Left(.Value, 1) <> DS And dSao < 8 Then
                dSao = 0
            End If
        End With
    Next Ff
 Next zZ
 Cells(1, Cols + 2) = Timer - Timer_
End Sub

 

[ptm0412]

Bác thêm vào 1 dòng nó tăng thêm thời gian là phải, Bác ạ.
Còn cái vụ không clear format ô nào cũng khổ lắm Bác ơi, nhỡ chủ đầu tư bớt hoặc sửa dữ liệu và chạy lại code, các ô lúc trước lỡ tô màu, bi giờ không thoả điều kiện nữa nhưng màu thì còn hoài.

 

[xda1811]

Bác thêm vào 1 dòng nó tăng thêm thời gian là phải, Bác ạ.
Còn cái vụ không clear format ô nào cũng khổ lắm Bác ơi, nhỡ chủ đầu tư bớt hoặc sửa dữ liệu và chạy lại code, các ô lúc trước lỡ tô màu, bi giờ không thoả điều kiện nữa nhưng màu thì còn hoài.

sư phụ xem lại cho em với. sao em ấn ctrl + T mà nó chẳng chạy gì? không biết em có nhầm chỗ nào không ?

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 - 1, i) = Chr(42) & k
            k = 0
        End If
   Next j
Next i
Sheet2.Cells(2, 3) = Timer
Application.ScreenUpdating = True
End Sub

 

[ptm0412]

Down file này về nè, lần sau cứ thế mà xài thôi. nếu có sự cố gì thì đừng làm gì cả, gọi ĐT cho anh là được: 09 19 77 2142

 

[ChanhTQ@]

Sai đâu sửa đó; sửa đó sai đâu?

Còn cái vụ không clear format ô nào cũng khổ lắm Bác ơi, nhỡ chủ đầu tư bớt hoặc sửa dữ liệu và chạy lại code, các ô lúc trước lỡ tô màu, bi giờ không thoả điều kiện nữa nhưng màu thì còn hoài.

Option Explicit
Sub ToMau()
 Const DS As String = "*"
 Dim Cols As Byte, zZ As Byte, dSao As Byte, bColor As Variant
 Dim Rws As Long, Ff As Long:               Dim Timer_ As Double
 
 Timer_ = Timer
 Cols = [iV2].End(xlToLeft).Column:         Application.ScreenUpdating = False
 Rws = [A65500].End(xlUp).Row + 1
 [b2].CurrentRegion.SpecialCells(xlCellTypeConstants, 2).ClearFormats
 For zZ = 1 To Cols
    dSao = 0
    For Ff = 1 To Rws
        With Cells(Ff, zZ)
            If Left(.Value, 1) = DS Then    '*'
                dSao = dSao + 1
            ElseIf Left(.Value, 1) <> DS And dSao > 7 Then
                .Offset(-1).Value = DS & dSao
                bColor = Switch(dSao < 16, 42, dSao < 26, 13, dSao < 41, 54)
                With .Offset(-dSao).Resize(dSao).Interior
                    .ColorIndex = bColor
                End With
                dSao = 0
            ElseIf Left(.Value, 1) <> DS And dSao < 8 Then
                dSao = 0
            End If
        End With
    Next Ff
 Next zZ
 Cells(1, Cols + 2) = Timer - Timer_
End Sub

Máy của PTM mạnh thiệt đó; "Một bước thỏ = 5 bước rùa!"
Nhờ bạn xem xét, test & cho í kiến tiếp, xin cảm ơn nhiều nha!

 

[ptm0412]

Thưa Bác, hôm nay thử trên máy công ty, của em 70.04588 giây, của Bác 80.704 giây. Mà sao nó lại xoá cả format các ô đỏ nhỉ?

Em thử chạy câu này trong immediate:

[b2].CurrentRegion.SpecialCells(xlCellTypeConstants, 2).ClearFormats

Thì bị xoá màu tất tần tật

Thế mà tô chọn 1 vùng nhỏ và dùng câu này:

Selection.SpecialCells(xlCellTypeConstants, 2).ClearFormats

Thì các ô số màu đỏ còn nguyên?
________________________

Về thử lại máy nhà: Code của bác nhanh hơn: 21.46 giây, của em 33.925 giây.
Nhưng sao vẫn bị mất màu đỏ hết tơn hết tọi?

 

[xda1811]

Em chào các anh
anh PT cho em hỏi thêm 1 chút nữa. em muốn thêm mấy điều kiện vào macro hôm trước anh giúp em

1. nếu gặp ô màu đỏ thì phía dưới nó sẽ hiện màu vàng và đếm số thứ tự đến khi có dữ liệu . ( em làm bằng tay ở file excel gửi kèm ).
Nếu sau ô màu đỏ > 8 ô mà ko có dữ liệu thì vẫn để màu xanh như cũ

2.nếu 2 hoặc 3 ô liên tiếp có dữ liệu thì được bôi màu xanh
anh giúp em với nhé
cảm ơn anh nhiều lắm

 

[ptm0412]

Tô màu kiểu 2

File đã xong.
Vì lần này đổi dấu * thành số từ 1 đến hết, nên không chạy lại lần 2, lần 3 như tô màu kiểu kia c nữa. Do đó phải sao lưu trước khi chạy.

Có thể làm 1 code để undo nhưng để sau nha. Hoặc nếu muốn thì kết hợp luôn, xóa màu tô cũ, đổi số thành *, tô lại. (Vì chưa biết cụ thể em muốn gì)

Còn bây giờ chịu khó thử trên file copy thôi. Thử 1 lần, copy lại dữ liệu chưa tô của file gốc, (chưa tô màu vàng), chạy thử nữa. Vừa ý rồi thì hãy thử trên file gốc.

Phím tắt lần này là Ctr+Q

 

[xda1811]

File đã xong.
Vì lần này đổi dấu * thành số từ 1 đến hết, nên không chạy lại lần 2, lần 3 như tô màu kiểu kia c nữa. Do đó phải sao lưu trước khi chạy.

Có thể làm 1 code để undo nhưng để sau nha. Hoặc nếu muốn thì kết hợp luôn, xóa màu tô cũ, đổi số thành *, tô lại. (Vì chưa biết cụ thể em muốn gì)

Còn bây giờ chịu khó thử trên file copy thôi. Thử 1 lần, copy lại dữ liệu chưa tô của file gốc, (chưa tô màu vàng), chạy thử nữa. Vừa ý rồi thì hãy thử trên file gốc.

Phím tắt lần này là Ctr+Q

anh ơi
em nhấn Ctrt +Q xong. ấn tiếp ctrl + T thì nó mất hết màu vàng
anh làm thế nao mà để em ấn Ctrt +T xong nó vẫn còn màu vàng.
anh thêm cho em đoạn code này với nhé
những ô nào ( 2 ô liên tiếp) dưới đoạn màu xanh và màu tím mà có số thì anh cho nó là màu nâu giúp em
và trong ô bất kỳ nếu 2 ô ( chỉ 2 ô thôi ) có số liên tiếp thì bôi 1 màu
giúp em với nhé
cảm ơn anh nhiều

 

[ptm0412]

1. Đã sửa vụ mất màu vàng khi tô 3 màu ctrl+T
2. Đã sửa code tô màu vàng: trước khi tô vàng, xóa màu vàng, trả các số thứ tự về *, rồi mới tô và đánh số lại.
3. Có thể phục hồi màu vàng thành không màu, số TT thành * nếu chạy riêng code UndoTwo, phím tắt là Ctr + w

 

[ptm0412]

File đã xong vụ tô màu 2 số liên tiếp
phím tắt là Ctrl + e, phục hồi là Ctrl + r

THử cho kỹ rồi hãy xài vô file thực nha, anh test sơ bộ rồi nhưng chỉ test với dữ liệu mẫu.

 

[ptm0412]

Có lỗi tô đè luôn ô màu vàng và màu đỏ nếu các ô này nằm giữa nhóm ô liên tiếp có số liệu. Tải lại file dưới đây

 

[xda1811]

Có lỗi tô luôn màu vàng và màu đỏ nếu các ô này nằm giữa nhóm ô liên tiếp có số liệu. Tải lại file dưới đây

vâng. em cũng đang định nhờ anh sửa hộ lỗi ấy

cảm ơn anh PTM nhiều lắm
chúc anh vui vẻ

 

[xda1811]

anh chỉnh thêm giúp em 1 chút
View attachment anh my.xls

sau ô màu nâu thì có đếm ngày cụ thể ở phía dưới

 

[ptm0412]

Xem file, code trong module "Count", phím tắt là Ctrl + Shift + Y

Chính xác là đếm ô có dấu * sau nhóm ô có màu tím than đầu tiên, cho đến khi gặp ô có số, đếm tiếp 1 lần nữa các ô có dấu *, gặp ô có số thì ngưng, qua cột kế.

Kết quả đếm cho vào sheet "Count" trên cột cùng tên.

 

[xda1811]

Xem file, code trong module "Count", phím tắt là Ctrl + Shift + Y

Chính xác là đếm ô có dấu * sau nhóm ô có màu tím than đầu tiên, cho đến khi gặp ô có số, đếm tiếp 1 lần nữa các ô có dấu *, gặp ô có số thì ngưng, qua cột kế.

Kết quả đếm cho vào sheet "Count" trên cột cùng tên.

anh ơi!
1. tai sheet count B1 đếm liên tiếp dùm em, nó như là phép thống kê ấy.
VD D7,D8 = tím than => count có B1 = 9. tiếp theo B2 =2
2. tiếp tục tại D59,D60 = tím than => count có B1 = 5, tiếp theo B2 = 5
3. tiếp tục tại D94,D95 = tím than => count có B1 = 9, tiếp theo B2 = 6
các cột khác đếm tương tự như cột D anh ạ
cứ thế liên tiếp đến D(n-2)D(n-1) ta sẽ có B1 = ..., b2 =..,

anh chỉnh dùm em với nha

 

[ptm0412]

Sao hôm qua bảo chỉ 2 bước thôi?

 

[xda1811]

Sao hôm qua bảo chỉ 2 bước thôi?

em diễn đạt kém lắm, anh bỏ qua cho em nhé, cảm ơn anh nhiều lắm

 

[ptm0412]

Nếu giữa 2 nhóm ô có màu tím than, chỉ đếm được 1 lần B1, thì có đếm không? nếu đếm thì B2 của lần đó bằng không haysao?

 

[xda1811]

Nếu giữa 2 nhóm ô có màu tím than, chỉ đếm được 1 lần B1, thì có đếm không? nếu đếm thì B2 của lần đó bằng không haysao?

vâng, gặp trường hợp như thế thì B2 = 0 anh ạ

 

[ptm0412]

Xong rồi. Test thử nha.

 

[xda1811]

anh thêm dùm em biến đếm này với :

điều kiện 1. Tại ô J2, k2 đều có dữ liệu ( tính từ trái sang phải,2 ô liền kề nhau có dữ liệu )
điều kiện 2. thống kê 10 hàng( hoặc 15,20 hàng.. chỗ này anh để mở dùm em), từ hàng 3 đến hàng 12 trong vùng D3:CY12, xem cột nào có số ô chứa dữ liệu nhiều nhất

Kết quả : hiện sang sheet khác tên cột có chứa dữ liệu nhiều nhất ( như trên J2,K2 có dữ liệu, kiểm tra trong 10 hàng sau đó thì có các cột sau có ô chứa dữ liệu nhiều, cột J,Q,AE,AP,AZ,BI,BR,CW là các cột có số ô chứa dữ liệu nhiều nhất )

em cảm ơn anh nhiều

 

[ThuNghi]

Tôi xin ké 1 câu hỏi, vì nội dung câu hỏi này cũng là tô màu theo điều kiện nên không lập topic mới.
Tôi có 1 sh Sổ kế toán trong đó tôi muốn tô màu theo điều kiện cột SoCT (Cột C).
Theo tiêu thức như sau:
Nếu số CT (Soct) khác nhau thì tô màu xen kẻ, dòng tô , dòng không tô. Nhằm mục đích dễ dàng đọc.
Ví dụ:
Cột C
SoCT
1--A001
2--A001
3--A002
4--A003
5--A004
6--A004
7--X006
...
Tôi muốn dòng 1, 2 tô màu, dòng 3 không tô, dòng 4 tô...
Tôi dùng ex 2007.
Nhờ các bạn viết giúp 1 code để thực hiện việc trên.
Xin cám ơn!

 

[ptm0412]

Code đếm cho xda1811. Xem file kèm theo

 

[ncq2003]

Mình có file này nhờ các bạn giúp giùm với Mình muốn đổi màu ký tự nguyên một dóng màu đỏ nếu tại cell Q của dòng đó là số 1, cón lại là không tô.
Nhờ các bạn giúp giùm mình có chú thíc câu hỏi trong file

 

[ncq2003]

Có ai giúp mình với, mình đang cần gấp

 

[SA_DQ]

Thấy bạn hối thúc quá, nên viết xài tạm

Option Explicit
Sub ToMauTheoCotQ()
 Dim Clls As Range
 For Each Clls In Range("Q37:Q" & [B65500].End(xlUp).Row)
   If Clls.Value = 1 Then
      Range("B" & Clls.Row & ":O" & Clls.Row).Interior.ColorIndex = 38 + Clls.Row Mod 2
   End If
 Next Clls
End Sub

 

[ncq2003]

Option Explicit
Sub ToMauTheoCotQ()
 Dim Clls As Range
 For Each Clls In Range("Q37:Q" & [B65500].End(xlUp).Row)
   If Clls.Value = 1 Then
      Range("B" & Clls.Row & ":O" & Clls.Row).Interior.ColorIndex = 38 + Clls.Row Mod 2
   End If
 Next Clls
End Sub

Bạn có thể chỉ mình cụ thể sử dụng như thế nào không?
Mình còn gà về excel lắm.
Thank