macro đổi màu 1 ô thành nhiều màu theo điều kiện

[huonglypolice]

mình có 1 yêu cầu sau: khi cột B2=1 thì A2 màu đỏ,C2=1 thì A2 màu xanh (tất nhiên là chỉ 1 trong các cột bằng 1 thôi, cái đó thì mình sử dụng bằng hộp thoại thông báo error alert đc rồi nhưng có macro đưa ra thông báo thì càng tốt), mình mới làm đc 3 màu theo conditional formatting và 1 màu đen mặc định nhưng nếu số lượng yêu cầu lớn hơn_tức là cần nhiều cột hơn để đổi màu của A2, a3... thì làm 1 macro ntn? mình đã thử làm rồi nhưng nó chạy chưa chính xác, mong các pro help! Tương tự như các dòng tiếp theo, duyệt từ b2, b3,...(dùng next i) và cả c2, c3....thank all, ôi ko thể attach file đc!

 

[ThuNghi]

mình có 1 yêu cầu sau: khi cột B2=1 thì A2 màu đỏ,C2=1 thì A2 màu xanh (tất nhiên là chỉ 1 trong các cột bằng 1 thôi, cái đó thì mình sử dụng bằng hộp thoại thông báo error alert đc rồi nhưng có macro đưa ra thông báo thì càng tốt), mình mới làm đc 3 màu theo conditional formatting và 1 màu đen mặc định nhưng nếu số lượng yêu cầu lớn hơn_tức là cần nhiều cột hơn để đổi màu của A2, a3... thì làm 1 macro ntn? mình đã thử làm rồi nhưng nó chạy chưa chính xác, mong các pro help! Tương tự như các dòng tiếp theo, duyệt từ b2, b3,...(dùng next i) và cả c2, c3....thank all, ôi ko thể attach file đc!

For i = 2 to endRow
if range("B" & i)=1 and range("C" & i)<>1 then range("A" & 2).Font.ColorIndex = 3
if range("B" & i)=1 and range("C" & i)=1 then range("A" & 2).Font.ColorIndex = 5
next i

Cứ thế mà phát huy. Xem lai chỉ số màu hộ.

 

[ST-Lu!]

Theo em thì phải thay and = or chứ nhỉ?
-----------------

 

[Po_Pikachu]

Mệnh đề And là trả về True khi cả hai mệnh đề con của nó đúng Mệnh đề Or là trả về True khi chỉ cần 1 trong hai mệnh đề con đúng. Vậy ở trường hợp này bạn chọn Anh hay Or. Thân.

 

[huonglypolice]

For i = 2 to endRow
if range("B" & i)=1 and range("C" & i)<>1 then range("A" & 2).Font.ColorIndex = 3
if range("B" & i)=1 and range("C" & i)=1 then range("A" & 2).Font.ColorIndex = 5
next i

Cứ thế mà phát huy. Xem lai chỉ số màu hộ.

mình ko thể làm ra đc, chỉ đổi màu đc 1 dòng đầu tiên (màu đỏ khi =3, chưa đổi đc màu xanh khi bằng 5 của cột C), mình có dùng next i rùi, lần trước mình có đoạn code cũng chạy bị lỗi như vậy (đang mới thử nghiệm với màu đỏ):
Sub Change()
n = Cells(1, 1).End(xlDown).Row
For i = 2 To n
If Cells(i, 1).Value = "1" Then
If Cells(i, 2).Font.ColorIndex <> 3 Then
Cells(i, 2).Font.ColorIndex = 3
Cells(i, 3).Font.ColorIndex = 3
Else
Cells(i, 2).Select
chon = MsgBox("Dong y doi lai mau?", vbYesNo, "Thong bao")
If chon = 6 Then
Cells(i, 2).Value = Cells(i, 2).font.colorindex=3
End If
End If
End If
Next i
End Sub
ko biết do lỗi gì nữa, mà lần trước có lần mình chạy thì nó cũng ra hàng loạt rồi nhưng ko hiện lên "thong bao" các bạn xem giúp mình nhé! thank all

 

[Po_Pikachu]

Bạn dùng thử code này xem.

Sub chang() For i = 1 To [A1].End(xlDown).Row     If Cells(i, "A").Font.ColorIndex = 3 Then         chon = MsgBox("Dong y doi lai mau?", vbYesNo, "Thong bao")     End If     If chon = 6 Then         If Cells(i, "B").Value = 1 And Cells(i, "C").Value  1 Then Cells(i, "A").Font.ColorIndex = 3         If Cells(i, "B").Value  1 And Cells(i, "C").Value = 1 Then Cells(i, "A").Font.ColorIndex = 5     End If Next End Sub

Thân.

 

[ThuNghi]

mình ko thể làm ra đc, chỉ đổi màu đc 1 dòng đầu tiên (màu đỏ khi =3, chưa đổi đc màu xanh khi bằng 5 của cột C), mình có dùng next i rùi, lần trước mình có đoạn code cũng chạy bị lỗi như vậy (đang mới thử nghiệm với màu đỏ):
Sub Change()
n = Cells(1, 1).End(xlDown).Row
For i = 2 To n
If Cells(i, 1).Value = "1" Then
If Cells(i, 2).Font.ColorIndex <> 3 Then
Cells(i, 2).Font.ColorIndex = 3
Cells(i, 3).Font.ColorIndex = 3
Else
Cells(i, 2).Select
chon = MsgBox("Dong y doi lai mau?", vbYesNo, "Thong bao")
If chon = 6 Then
Cells(i, 2).Value = Cells(i, 2).font.colorindex=3

End If
End If
End If
Next i
End Sub
ko biết do lỗi gì nữa, mà lần trước có lần mình chạy thì nó cũng ra hàng loạt rồi nhưng ko hiện lên "thong bao" các bạn xem giúp mình nhé! thank all

Cells(i, 2).Value = Cells(i, 2).font.colorindex=3
Cái dòng này sai, phải là
Cells(i, 2).font.colorindex=3

If Cells(i, 1).Value = "1" hay
If Cells(i, 1).Value = 1

 

[huonglypolice]

Bạn dùng thử code này xem.

Sub chang()
For i = 1 To [A1].End(xlDown).Row
    If Cells(i, "A").Font.ColorIndex = 3 Then
        chon = MsgBox("Dong y doi lai mau?", vbYesNo, "Thong bao")
    End If
    If chon = 6 Then
        If Cells(i, "B").Value = 1 And Cells(i, "C").Value <> 1 Then Cells(i, "A").Font.ColorIndex = 3
        If Cells(i, "B").Value <> 1 And Cells(i, "C").Value = 1 Then Cells(i, "A").Font.ColorIndex = 5
    End If
Next
End Sub

Thân.

Thank bạn nhìu nhưng mà thế này: mình ko cần dùng hàm and kia đâu, vì mình có khoảng 6 cột để đổi màu cơ, nếu làm từng cột bằng 1 và các cột khác phải khác 1 thì dài dòng lắm, mình vừa chuyển thành thế này:
Sub changecolor()
n = Cells(1, 1).End(xlDown).Row
For i = 2 To n
If Range("B" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 3
If Range("C" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 13
If Range("D" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 5
If Range("E" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 7
If Range("F" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 1
If Range("G" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 13
Next i
End Sub
và mình đã chạy đc đúng các màu, mỗi tội là chỉ dùng đc cho dòng đầu tiên, hjc hjc, thế mới buồn chứ lại! Mình chạy thử code bạn vừa gửi rồi nhưng chưa chạy được, nó còn ko đc như cái code đầu bạn ạ. Bạn nghiên cứu giúp mình nhé!

 

[ThuNghi]

Thank bạn nhìu nhưng mà thế này: mình ko cần dùng hàm and kia đâu, vì mình có khoảng 6 cột để đổi màu cơ, nếu làm từng cột bằng 1 và các cột khác phải khác 1 thì dài dòng lắm, mình vừa chuyển thành thế này:
Sub changecolor()
n = Cells(1, 1).End(xlDown).Row
For i = 2 To n
If Range("B" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 3
If Range("C" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 13
If Range("D" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 5
If Range("E" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 7
If Range("F" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 1
If Range("G" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 13
Next i
End Sub
và mình đã chạy đc đúng các màu, mỗi tội là chỉ dùng đc cho dòng đầu tiên, hjc hjc, thế mới buồn chứ lại! Mình chạy thử code bạn vừa gửi rồi nhưng chưa chạy được, nó còn ko đc như cái code đầu bạn ạ. Bạn nghiên cứu giúp mình nhé!

1/ Bạn xem lại biến n xem có khi là cột A có dòng rỗng nên biên n =1, vậy thử thay thành
n = Cells(10000, 1).End(xlUp).Row
2/ Range("A" & 2) hay là Range("A" & i)
3/
If Range("C" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 13
If Range("G" & i) = 1 Then Range("A" & 2).Font.ColorIndex = 13
Cái này dùng or.
Nếu có file thì OK hơn.

 

[Po_Pikachu]

Chỉ dòng đầu thôi vì bạn ghi rằng Range("A" & 2) mà! Bạn xem lại code này nha!

Sub changecolor() n = Cells(1, 1).End(xlDown).Row For i = 2 To n If Range("B" & i) = 1 Then Range("A" & i).Font.ColorIndex = 3 If Range("C" & i) = 1 Then Range("A" & i).Font.ColorIndex = 13 If Range("D" & i) = 1 Then Range("A" & i).Font.ColorIndex = 5 If Range("E" & i) = 1 Then Range("A" & i).Font.ColorIndex = 7 If Range("F" & i) = 1 Then Range("A" & i).Font.ColorIndex = 1 If Range("G" & i) = 1 Then Range("A" & i).Font.ColorIndex = 13 Next i End Sub

Thân.

 

[ChanhTQ@]

Tô chục màu nền luôn!

Bằng macro sau:

Option Explicit
Sub ColorFor()
 Dim Rng As Range:      Dim ARw As Long
 Const CanTim As Integer = 1
 
 ARw = ActiveCell.Row
 Set Rng = Range(Cells(ARw, "B"), Cells(ARw, 256).End(xlToLeft))
 Set Rng = Rng.Find(what:=CanTim, LookIn:=xlValues, lookat:=xlWhole)
 If Not Rng Is Nothing Then _
   Cells(ARw, "A").Interior.ColorIndex = 33 + (Rng.Column Mod 10)
End Sub

Chú ý: Hiện số cần tìm là '1';
Nếu các hàng khác nhau cần các số khác nhau thì thay đổi cho thích hợp

 

[huonglypolice]

Cám ơn các bạn, bài mình chạy tốt rồi, đúng là phải có gì đó ở dòng đầu tiên thì mới tự thay đổi màu ở các bảng khác, thank các bạn nhìu lém! Nhưng mà phát sinh 1 việc là khi cái bài đó có nhiều sheet thì sao? mình muốn chỉ định đến đúng cái sheet đó thì dùng câu lệnh gì?

Chạy được rồi nhưng mà chỉ đc có hơn chục dòng là tự ngừng lại, tức là các dòng sau vẫn ko đổi màu, có ai bít vì sao ko? vẫn bài tập này đó!

 

[ThuNghi]

Chạy được rồi nhưng mà chỉ đc có hơn chục dòng là tự ngừng lại, tức là các dòng sau vẫn ko đổi màu, có ai bít vì sao ko? vẫn bài tập này đó!

Bạn up file được không, thường là file tìm theo màu chạy chậm. Bạn đang dùng code nào.
Bạn làm tạm ví dụ vài dòng trên đây để tôi tự copy (nếu không up được) và code nhé.

 

[huonglypolice]

Bạn up file được không, thường là file tìm theo màu chạy chậm. Bạn đang dùng code nào.
Bạn làm tạm ví dụ vài dòng trên đây để tôi tự copy (nếu không up được) và code nhé.

code của mình đây:
Sub changecolor()
n = Cells(1, 1).End(xlDown).Row
For i = 2 To n
If Range("g" & i) = 1 Then Range("A" & i).Font.ColorIndex = 3
If Range("i" & i) = 1 Then Range("A" & i).Font.ColorIndex = 13
If Range("k" & i) = 1 Then Range("A" & i).Font.ColorIndex = 5
If Range("o" & i) = 1 Then Range("A" & i).Font.ColorIndex = 7
If Range("q" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9
If Range("s" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9
If Range("G" & i) = "" and Range("I" & i) = "" AND Range("K" & i) = "" AND Range("O" & i) = "" AND Range("Q" & i) = "" AND Range("S" & i) = "" Then Range("A" & i).Font.ColorIndex = 1
Next i
End Sub
Chạy ít dữ liệu thì rất ok nhưng chạy nhiều dữ liệu thì báo lỗi!

 

[ThuNghi]

code của mình đây:
Sub changecolor()
n = Cells(1, 1).End(xlDown).Row
For i = 2 To n
If Range("g" & i) = 1 Then Range("A" & i).Font.ColorIndex = 3
If Range("i" & i) = 1 Then Range("A" & i).Font.ColorIndex = 13
If Range("k" & i) = 1 Then Range("A" & i).Font.ColorIndex = 5
If Range("o" & i) = 1 Then Range("A" & i).Font.ColorIndex = 7
If Range("q" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9
If Range("s" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9
If Range("G" & i) = "" and Range("I" & i) = "" AND Range("K" & i) = "" AND Range("O" & i) = "" AND Range("Q" & i) = "" AND Range("S" & i) = "" Then Range("A" & i).Font.ColorIndex = 1
Next i
End Sub
Chạy ít dữ liệu thì rất ok nhưng chạy nhiều dữ liệu thì báo lỗi!

Tôi chạy thử khỏan 500 dòng mà đâu báo lỗi gì.
Rút gọn code 1 chút nhé.

Sub ChangeColor()
n = Cells(1, 1).End(xlDown).Row
For i = 2 To n
    If Range("g" & i) = 1 Then Range("A" & i).Font.ColorIndex = 3
    If Range("i" & i) = 1 Then Range("A" & i).Font.ColorIndex = 13
    If Range("k" & i) = 1 Then Range("A" & i).Font.ColorIndex = 5
    If Range("o" & i) = 1 Then Range("A" & i).Font.ColorIndex = 7
    If Range("q" & i) = 1 Or Range("s" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9
    If Range("G" & i) & Range("I" & i) & Range("K" & i) & Range("O" & i) = "" And Range("Q" & i) & Range("S" & i) = "" Then Range("A" & i).Font.ColorIndex = 1
Next i
End Sub

Và chạy thử code này thế nào.

Sub Change_Color()
n = Cells(1, 1).End(xlDown).Row
For i = 2 To n
' mau den la 1 thi co can khong'
    If Range("G" & i) & Range("I" & i) & Range("K" & i) & Range("O" & i) = "" And Range("Q" & i) & Range("S" & i) = "" Then
        Range("B" & i).Font.ColorIndex = 1
    Else
        If Range("q" & i) = 1 Or Range("s" & i) = 1 Then
            Range("B" & i).Font.ColorIndex = 9
        Else
            If Range("O" & i) = 1 Then
                Range("B" & i).Font.ColorIndex = 7
            Else
                If Range("K" & i) = 1 Then
                    Range("B" & i).Font.ColorIndex = 5
                Else
                    If Range("I" & i) = 1 Then
                        Range("B" & i).Font.ColorIndex = 13
                    Else
                        If Range("G" & i) = 1 Then
                            Range("B" & i).Font.ColorIndex = 3
                        End If
                    End If
                End If
            End If
        End If
    End If
Next i
End Sub

 

[Lệnh Hồ Đại Hiệp]

code của mình đây:
Sub changecolor()
n = Cells(1, 1).End(xlDown).Row
For i = 2 To n
If Range("g" & i) = 1 Then Range("A" & i).Font.ColorIndex = 3
If Range("i" & i) = 1 Then Range("A" & i).Font.ColorIndex = 13
If Range("k" & i) = 1 Then Range("A" & i).Font.ColorIndex = 5
If Range("o" & i) = 1 Then Range("A" & i).Font.ColorIndex = 7
If Range("q" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9
If Range("s" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9
If Range("G" & i) = "" and Range("I" & i) = "" AND Range("K" & i) = "" AND Range("O" & i) = "" AND Range("Q" & i) = "" AND Range("S" & i) = "" Then Range("A" & i).Font.ColorIndex = 1
Next i
End Sub
Chạy ít dữ liệu thì rất ok nhưng chạy nhiều dữ liệu thì báo lỗi!

Với mỗi i (một dòng) thì phải xét bằng đó cái if thì có mà treo máy ngay.
Bạn xem lại nhé :

Sub ChangeColor()
    Dim i As Long, iC As Long
    Range("A2:A" & iC).Font.ColorIndex = 1
    For i = 2 To iC
        If Range("G" & i) = 1 Then Range("A" & i).Font.ColorIndex = 3: GoTo Tiep
        If Range("I" & i) = 1 Then Range("A" & i).Font.ColorIndex = 13: GoTo Tiep
        If Range("K" & i) = 1 Then Range("A" & i).Font.ColorIndex = 5: GoTo Tiep
        If Range("O" & i) = 1 Then Range("A" & i).Font.ColorIndex = 7: GoTo Tiep
        If Range("Q" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9: GoTo Tiep
        If Range("S" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9: GoTo Tiep
        ''' Dong duoi nay co le khong can thiet
        If Range("G" & i) & Range("I" & i) & Range("K" & i) & Range("O" & i) & Range("Q" & i) & Range("S" & i) = "" _
                              Then Range("A" & i).Font.ColorIndex = 1
Tiep:
    Next i
End Sub

Và nhớ khai báo biến cho tường minh nhé

Ngoài ra nếu các nếu các cột liền kề nhau thì bạn dùng phương thức Find sẽ nhanh hơn rất nhiều.

Chúc vui.

 

[ThuNghi]

Sub ChangeColor()
    For i = 2 To iC
        If Range("G" & i) = 1 Then Range("A" & i).Font.ColorIndex = 3: GoTo Tiep
        If Range("I" & i) = 1 Then Range("A" & i).Font.ColorIndex = 13: GoTo Tiep
        If Range("K" & i) = 1 Then Range("A" & i).Font.ColorIndex = 5: GoTo Tiep
        If Range("O" & i) = 1 Then Range("A" & i).Font.ColorIndex = 7: GoTo Tiep
        If Range("Q" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9: GoTo Tiep
        If Range("S" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9: GoTo Tiep
[/quote]
Đọan này phải xếp thứ tự ngược lại mới đúng ý thì phải.
    [PHP]    If Range("S" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9: GoTo Tiep
'....'
        If Range("O" & i) = 1 Then Range("A" & i).Font.ColorIndex = 7: GoTo Tiep
'...'
        If Range("G" & i) = 1 Then Range("A" & i).Font.ColorIndex = 3: GoTo Tiep

 

[Lệnh Hồ Đại Hiệp]

Đọan này phải xếp thứ tự ngược lại mới đúng ý thì phải.

    If Range("S" & i) = 1 Then Range("A" & i).Font.ColorIndex = 9: GoTo Tiep
'....'
        If Range("O" & i) = 1 Then Range("A" & i).Font.ColorIndex = 7: GoTo Tiep
'...'
        If Range("G" & i) = 1 Then Range("A" & i).Font.ColorIndex = 3: GoTo Tiep

Em cũng không rõ lắm, chỉ nhìn vào Code của tác giả để sửa lại thôi.
Việc duyệt ưu tiên từ cột nào thì em không thấy nói đến.
Cảm ơn bác.

 

[ChanhTQ@]

Cho vào vòng lặp để dễ nhìn!

.

Option Explicit

Sub ChangeColor()
    Dim iJ As Long, iC As Long, Jf As Long
    Const Str_ As String = "GIKOQS"
 
    iC = [a65500].End(xlUp).Row '*?*'
    Range("A2:A" & iC).Font.ColorIndex = 1
    For iJ = 2 To iC
      For Jf = 1 To 6
         If Cells(iJ, Mid(Str_, Jf, 1)).Value = 1 Then _
            Cells(iJ, "A").Interior.ColorIndex = Jf + 33
      Next 
        ' Dong duoi nay co le khong can thiet'
        If Range("G" & iJ) & Range("iJ" & iJ) & Range("K" & iJ) & _
            Range("O" & iJ) & Range("Q" & iJ) & Range("S" & iJ) = "" _
            Then Range("A" & iJ).Font.ColorIndex = 1
Tiep:
    Next iJ
End Sub

 

[ThuNghi]

Option Explicit

...
    Const Str_ As String = "GIKOQS"
     iC = [a65500].End(xlUp).Row '*?*'
    Range("A2:A" & iC).Font.ColorIndex = 1
    For iJ = 2 To iC
      For Jf = 1 To 6
         If Cells(iJ, Mid(Str_, Jf, 1)).Value = 1 Then _
            Cells(iJ, "A").Interior.ColorIndex = Jf + 33
      Next 
  Tiep:
    Next iJ

Theo tôi phải là

Const Str_ As String = "GIKOQS"
     iC = [a65500].End(xlUp).Row '*?*'
    Range("A2:A" & iC).Font.ColorIndex = 1
    For iJ = 2 To iC
      For Jf = 6 To 1
         If Cells(iJ, Mid(Str_, Jf, 1)).Value = 1 Then
            Cells(iJ, "A").Interior.ColorIndex = Jf + 33
exit for
end if
      Next 
  Tiep:
    Next iJ

Nến xét rừ phải qua. Nếu thỏa thì next iJ sẽ giảm số lần Next (theo như yêu cầu)