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

Quảng cáo

PacificPR

Thành viên mới
Tham gia ngày
6 Tháng năm 2016
Bài viết
1,995
Được thích
2,726
Điểm
1,168
Nơi ở
Cái Bang

giangintem

Thành viên mới
Tham gia ngày
19 Tháng tư 2011
Bài viết
16
Được thích
4
Điểm
303
Tuổi
46
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

Thành viên tích cực
Tham gia ngày
11 Tháng mười một 2016
Bài viết
1,360
Được thích
1,252
Điểm
668
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

Thành viên mới
Tham gia ngày
19 Tháng tư 2011
Bài viết
16
Được thích
4
Điểm
303
Tuổi
46
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

Thành viên mới
Tham gia ngày
18 Tháng mười một 2016
Bài viết
7
Được thích
2
Điểm
0
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ị
 

File đính kèm

  • Bôi màu.xlsx
    10.7 KB · Đọc: 8

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
1,385
Được thích
1,506
Điểm
668
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
 
Lần chỉnh sửa cuối:

tranthemai

Thành viên mới
Tham gia ngày
18 Tháng mười một 2016
Bài viết
7
Được thích
2
Điểm
0
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
 

File đính kèm

  • LUONG SL TS 11 2019.xlsm
    100.1 KB · Đọc: 4

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
1,385
Được thích
1,506
Điểm
668
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

Thành viên mới
Tham gia ngày
18 Tháng mười một 2016
Bài viết
7
Được thích
2
Điểm
0
Đ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)
Đ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
 
Quảng cáo
Top Bottom