Tô màu theo điều kiện bằng VBA?

Miền Cát Trắng · 3/1/14

Xin kính chào mọi người.
Tôi đang gặp phải một vấn đề như đã nêu rõ trong file đính kèm.
Nếu sử dụng chức năng CF thì tôi có thể làm được nhưng tôi muốn tìm hiểu khi làm bằng vba. Mong mọi người giúp đỡ.
Xin cảm ơn!

PacificPR · 30/10/20

giangintem đã viết:
Mình đã tô được màu từng cùng cố định. Nhưng mình muốn dùng code để tự động tô mà không chỉnh từ vùng

Nhà mình có thể cho một ít dữ liệu vào cái bảng đó không. Cơ sở để ngăn cách vùng là gì vậy

giangintem · 30/10/20

Cám ơn cả nhà, Mình đã làm được
Mình tô màu theo vùng và chạy code mẫu, lấy code mẫu pass vô và điều chỉnh ô lại theo mong muốn
Range("A6:G14").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 13434879
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A15:G23").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 13434828
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveWindow.SmallScroll Down:=15
Range("A24:G50").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16772300
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B21").Select
ActiveWindow.SmallScroll Down:=-21
Range("A6:G50").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Range("F16").Select
ActiveWindow.SmallScroll Down:=-30
Range("F11").Select
ActiveWindow.SmallScroll Down:=-42
Range("F11").Select

Nhattanktnn · 30/10/20

giangintem đã viết:
Cám ơn cả nhà, Mình đã làm được
Mình tô màu theo vùng và chạy code mẫu, lấy code mẫu pass vô và điều chỉnh ô lại theo mong muốn
Range("A6:G14").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 13434879
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A15:G23").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 13434828
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveWindow.SmallScroll Down:=15
Range("A24:G50").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16772300
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B21").Select
ActiveWindow.SmallScroll Down:=-21
Range("A6:G50").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Range("F16").Select
ActiveWindow.SmallScroll Down:=-30
Range("F11").Select
ActiveWindow.SmallScroll Down:=-42
Range("F11").Select

À tức là cái chỗ dài thòng lòng đó nó gần gần như này đấy bạn:

Mã:

Sub ToMauSieuTuDong()
    Range("A6:G14").Interior.ColorIndex = 36
    Range("A15:G23").Interior.ColorIndex = 20
    Range("A24:G50").Interior.ColorIndex = 37
    Range("A6:G50").Borders.LineStyle = xlContinuous
End Sub

giangintem · 30/10/20

Cám ơn Bạn, mình không biết làm nên chỉ làm được như vậy thôi. Mình copy và sử dụng đoạn code của Bạn cũng được rồi

tranthemai · 27/11/20

Cho em hỏi cách tô màu với:
Nếu thu được tiền liên tục trong 10 ngày thì ngày thứ 7 bôi màu cam,
nếu 14 ngày liên tục thì ngày thứ 7 và ngày thứ 14 bôi màu cam,
Nếu 21 ngày liên tục thì ngày thứ 7, 14 và 21 bôi màu cam
Nếu 28 ngày liên tục thì ngày thứ 7, 14, 21, 28 bôi màu cam
nếu ngày nào không thu được tiền thì bôi màu vàng
còn lại các ngày màu trắng
Tính tổng số tiền các ngày màu cam của từng người
cám ơn các anh chị

CHAOQUAY · 28/11/20

tranthemai đã viết:
Cho em hỏi cách tô màu với:
Nếu thu được tiền liên tục trong 10 ngày thì ngày thứ 7 bôi màu cam,
nếu 14 ngày liên tục thì ngày thứ 7 và ngày thứ 14 bôi màu cam,
Nếu 21 ngày liên tục thì ngày thứ 7, 14 và 21 bôi màu cam
Nếu 28 ngày liên tục thì ngày thứ 7, 14, 21, 28 bôi màu cam
nếu ngày nào không thu được tiền thì bôi màu vàng
còn lại các ngày màu trắng
Tính tổng số tiền các ngày màu cam của từng người
cám ơn các anh chị

Thử code dưới đây

Mã:

Option Explicit

Sub A_mau_tien()
Dim DL, tien
Dim i, j, k, t
With Sheet1
    DL = .Range("A2", .Range("AF" & Rows.Count).End(xlUp))
    .Range("A2", .Range("AF" & Rows.Count).End(xlUp)).ClearFormats
    .Range("A2", .Range("AF" & Rows.Count).End(xlUp)).Borders.LineStyle = 1
    For i = 1 To UBound(DL)
        k = 0
        tien = 0
        For j = 2 To 32
            If DL(i, j) > 0 Then
                k = k + 1
                If k = 10 Then
                    t = j - 4
                Else
                    If k > 10 And k Mod 7 = 0 Then t = j - 1
                End If
                If t Then
                    'tien = tien + DL(i, j)
                    tien = tien + DL(i, t + 1)'<--sua lai
                    .Range("A" & i + 1).Offset(, t).Select
                    Macro1
                    t = 0
                End If
            Else
                .Range("A" & i + 1).Offset(, j - 1).Select
                Macro2
                k = 0
            End If
        Next j
        .Range("AG" & i + 1) = tien
    Next i
End With
End Sub

Sub Macro1()
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub
Sub Macro2()
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

tranthemai · 28/11/20

Bác ChaoQuay sửa hộ em cái này với, khi đưa code của bác vào dữ liệu thì em đã sửa lại những cái em biết thì thấy phần tô màu đúng rồi, còn phần tính tổng theo màu vẫn gặp khó khăn, em thấy nó tự lấy dữ liệu ở ô số 10 đem cộng với những ô màu cam khác chứ không phải ở ô thứ 7 có màu cam

CHAOQUAY · 28/11/20

tranthemai đã viết:
Bác ChaoQuay sửa hộ em cái này với, khi đưa code của bác vào dữ liệu thì em đã sửa lại những cái em biết thì thấy phần tô màu đúng rồi, còn phần tính tổng theo màu vẫn gặp khó khăn, em thấy nó tự lấy dữ liệu ở ô số 10 đem cộng với những ô màu cam khác chứ không phải ở ô thứ 7 có màu cam

Đoạn code trên cộng tiền bị lỗi, sorry.
Bạn xem lại bên dưới, thay dòng trên = dòng dưới là được

Mã:

If t Then
    'tien = tien + DL(i, j)
                    
    tien = tien + DL(i, t + 1)

tranthemai · 29/11/20

CHAOQUAY đã viết:
Đoạn code trên cộng tiền bị lỗi, sorry.
Bạn xem lại bên dưới, thay dòng trên = dòng dưới là được

Mã:

If t Then 'tien = tien + DL(i, j) tien = tien + DL(i, t + 1)

Thanks Bac chuẩn rồi bác. Cám ơn bác đã giúp đỡ em nhiệt tình

huongmuine · 4/1/22

Nhờ các anh chị giúp tô màu các ô theo điều kiện ( Yêu cầu nêu rõ trong file ).
Cảm ơn rất nhiều.

giaiphap · 4/1/22

huongmuine đã viết:
Nhờ các anh chị giúp tô màu các ô theo điều kiện ( Yêu cầu nêu rõ trong file ).
Cảm ơn rất nhiều.

Cái này dùng thử CF kết quả cũng được.

huongmuine · 4/1/22

giaiphap đã viết:
Cái này dùng thử CF kết quả cũng được.

Hôm trước mình cũng làm thế nhưng sau khi CF xong nó xóa mất tiêu các định dạng của mình ( Có lẽ do lỗi của file ). Cảm ơn bạn đã hỗ trợ.

Bài đã được tự động gộp: 4/1/22

huongmuine đã viết:
Hôm trước mình cũng làm thế nhưng sau khi CF xong nó xóa mất tiêu các định dạng của mình ( Có lẽ do lỗi của file. File sử dụng vba để Highlight ). Cảm ơn bạn đã hỗ trợ.

kokoro mitsubishi · 7/6/22

Xin phép diễn đàn
em cũng có nội dung tương tự nhờ thầy và các anh chị em hỗ trợ thay thế bằng VBA
Hiện tại file đính kèm đang sử dụng định dạng có điều kiện
tuy nhiên số lượng ít dòng thì dùng OK nhưng khi lên đến 800 dòng file chậm quá
Điều kiện em cũng đã ghi trong file

em trân thành cảm ơn anh chị

Luong24 · 13/10/22

Ba Tê đã viết:
Public Sub GPE() Dim Rng As Range, Cll As Range, DK As Long With Sheet1 DK = .[C5].Value .[C8:K1000].Interior.ColorIndex = 0 Set Rng = .Range(.[C8], .[C8].End(xlDown)) For Each Cll In Rng If Cll.Value = DK Then Cll.Resize(, 9).Interior.ColorIndex = 6 MsgBox "Ma oi, Ma oi ..... Cuu con!" End If Next Cll End With

Ba Tê đã viết:

Xem Cái "má ơi...má ơi ..." này thử xem, sao nhiều cái "oái oăm" vậy?

PHP:

Public Sub GPE()
Dim Rng As Range, Cll As Range, DK As Long, MaOI As Range
With Sheet1
    DK = .[C5].Value
    Set MaOI = Union(.[C8:E17], .[G8:I17], .[K8:K17])
    MaOI.Interior.ColorIndex = 0
    Set Rng = .Range(.[C8], .[C8].End(xlDown))
    For Each Cll In Rng
        If Cll.Value = DK Then
            Set MaOI = Union(Cll.Resize(, 3), Cll.Offset(, 4).Resize(, 3), Cll.Offset(, 8))
            MaOI.Interior.ColorIndex = 6
            MsgBox "Ma oi, Ma oi ..... Cuu con!"
        End If
    Next Cll
End With
Set Rng = Nothing
Set MaOI = Nothing
End Sub

nếu thay C5 bằng 1 vùng dữ liệu từ c5 tới c 200 thì sao ạ?

Hoàng Tuấn 868 · 13/10/22

Luong24 đã viết:
nếu thay C5 bằng 1 vùng dữ liệu từ c5 tới c 200 thì sao ạ?

Cứ thử thì sẽ biết thôi.

Luong24 · 13/10/22

Hoàng Tuấn 868 đã viết:
Cứ thử thì sẽ biết thôi.

Nhưng em không biết khai báo sao cho OK ạ vì đã thử khai báo rồi nhưng không được.
Em mới tìm hiểu về VBA, mong mọi người chỉ giáo thêm.
Em cảm ơn!

Hoàng Tuấn 868 · 13/10/22

Luong24 đã viết:
Nhưng em không biết khai báo sao cho OK ạ vì đã thử khai báo rồi nhưng không được.

Trong đoạn code trên làm gì có biến nào tên là "OK" đâu mà cần khai báo cho nó hả bạn.

Luong24 · 13/10/22

Hoàng Tuấn 868 đã viết:
Trong đoạn code trên làm gì có biến nào tên là "OK" đâu mà cần khai báo cho nó hả bạn.

Nghĩa là như này
DK = .[C5].Value
Giờ e muốn thay C5 bằng 1 vùng dữ liệu chứ không phải 1 ô ( từ ô C5 đến ô C200 ) thì viết như nào ạ?

Hoàng Tuấn 868 · 13/10/22

Luong24 đã viết:
Giờ e muốn

Đầu tiên hãy sửa từ viết tắt rồi bàn tiếp nhỉ.

SA_DQ · 14/10/22

Luong24 đã viết:
Nghĩa là như này
DK = .[C5].Value
Giờ e muốn thay C5 bằng 1 vùng dữ liệu chứ không phải 1 ô ( từ ô C5 đến ô C200 ) thì viết như nào ạ?

File của chủ bài đăng có 1 ô điều kiện & 1 vùng cần xem xét để tô màu;
Cái chính là vùng xem xét tô màu đang là [C8:K17]
Như bạn nêu là ô điều kiện biến thành vùng điều kiện & đã ghi rõ là [C5:C200]
Vậy là vùng điều kiện đã chồng lấn lên vùng cần khảo sát để tô màu
Chuyện này dễ diễn ra chiến tranh nếu 2 vùng đó là lãnh thổ của 2 nước láng giềng thù địch nhau!
Trước tiên là bạn phải tách phần chồng lấn của 2 vùng này ra rạch ròi cái đã!

Tô màu theo điều kiện bằng VBA?

Thành viên hoạt động

File đính kèm

Thành viên mới

Thành viên mới

Thành viên gắn bó

Thành viên mới

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên mới

Thành viên GPE

File đính kèm

==(^o^)==

File đính kèm

Thành viên GPE

Thành viên chính thức

File đính kèm

Thành viên mới

Đăng ký hôm qua

Thành viên mới

Đăng ký hôm qua

Thành viên mới

Đăng ký hôm qua

/(hông là gì!

Đếm ngược thời gian