Marco tô màu theo điều kiện? (1 người xem)

[311280]

Nhờ các bác viết giùm e con marco,yêu cầu nằm trong file đính kèm.Thanks.

 

[311280]

Bạn tự kiểm tra lại xem bạn sửa code đúng như anh hoangvuluan chưa nhé

Cảm ơn bác,e đã sửa lại bài 19,nhờ các bác xem giúp.

quần áo trẻ em | quan ao tre em | quần áo sơ sinh | quần áo bé trai | quần áo bé gái | bodysuit carter | quan ao so sinh | quan ao tre em nhap khau

 

[hoangvuluan]

Cảm ơn bác,e đã sửa lại bài 19,nhờ các bác xem giúp.

Thay 2 macro trên bằng 2 macro sau:

Option Explicit
Private Sub CommandButton1_Click()
Dim r As Range, a(), i As Long, iR As Long, iC As Long, j As Long
With Application
.ScreenUpdating = False
    Set r = ActiveSheet.Range("a10")
    Set r = ActiveSheet.Range(r, r.End(xlToRight).End(xlDown))
    iR = r.Rows.Count
    ReDim a(1 To iR, 1 To 3)
    a = r
    ReDim Preserve a(1 To iR, 1 To 4)
    For i = 1 To iR - 1
        For j = i + 1 To iR
            If a(j, 4) = 0 Then
            If a(i, 1) = a(j, 1) And a(i, 2) = a(j, 2) And a(i, 3) = a(j, 3) Then
                If a(i, 4) = 0 Then
                    r.Rows(i).Font.Color = 255
                    a(i, 4) = 1
                End If
                a(j, 4) = 1
                r.Rows(j).EntireRow.Hidden = True
            End If
            End If
        Next
    Next
    Set r = Nothing
    Erase a
.ScreenUpdating = True
End With
End Sub
 
Private Sub CommandButton2_Click()
Dim r As Range
    Set r = ActiveSheet.Range("a10")
    Set r = ActiveSheet.Range(r, r.End(xlToRight).End(xlDown))
    r.Rows.EntireRow.Hidden = False
    r.Rows.Font.Color = 0
    Set r = Nothing
End Sub

 

[311280]

Thay 2 macro trên bằng 2 macro sau:

Option Explicit
Private Sub CommandButton1_Click()
Dim r As Range, a(), i As Long, iR As Long, iC As Long, j As Long
With Application
.ScreenUpdating = False
    Set r = ActiveSheet.Range("a10")
    Set r = ActiveSheet.Range(r, r.End(xlToRight).End(xlDown))
    iR = r.Rows.Count
    ReDim a(1 To iR, 1 To 3)
    a = r
    ReDim Preserve a(1 To iR, 1 To 4)
    For i = 1 To iR - 1
        For j = i   1 To iR
            If a(j, 4) = 0 Then
            If a(i, 1) = a(j, 1) And a(i, 2) = a(j, 2) And a(i, 3) = a(j, 3) Then
                If a(i, 4) = 0 Then
                    r.Rows(i).Font.Color = 255
                    a(i, 4) = 1
                End If
                a(j, 4) = 1
                r.Rows(j).EntireRow.Hidden = True
            End If
            End If
        Next
    Next
    Set r = Nothing
    Erase a
.ScreenUpdating = True
End With
End Sub
 
Private Sub CommandButton2_Click()
Dim r As Range
    Set r = ActiveSheet.Range("a10")
    Set r = ActiveSheet.Range(r, r.End(xlToRight).End(xlDown))
    r.Rows.EntireRow.Hidden = False
    r.Rows.Font.Color = 0
    Set r = Nothing
End Sub

Cảm ơn sự nhiệt tình giúp đỡ của bác,nhưng bác xem lại giúp e.Nhấn Commandbutton1 thì ok,còn khi nhấn commandbutton2 thì nó không unhide dòng 52 và 53.

quần áo trẻ em | quan ao tre em | quần áo sơ sinh | quần áo bé trai | quần áo bé gái | bodysuit carter | quan ao so sinh | quan ao tre em nhap khau

 

[ndu96081631]

Cảm ơn sự nhiệt tình giúp đỡ của bác,nhưng bác xem lại giúp e.Nhấn Commandbutton1 thì ok,còn khi nhấn commandbutton2 thì nó không unhide dòng 52 và 53.

Vì code dùng End(xlUp) nên sẽ cho kết quả sai trong trường hợp có dòng ẩn ở cuối dữ liệu
Bạn sửa code này thành vầy là được rồi:

Private Sub CommandButton2_Click()
  With ActiveSheet.Range("A:A").EntireRow
    .Hidden = False: .Font.Color = 0
  End With
End Sub

 

[311280]

Vì code dùng End(xlUp) nên sẽ cho kết quả sai trong trường hợp có dòng ẩn ở cuối dữ liệu
Bạn sửa code này thành vầy là được rồi:

Private Sub CommandButton2_Click()
  With ActiveSheet.Range("A:A").EntireRow
    .Hidden = False: .Font.Color = 0
  End With
End Sub

Khắc phục được không unhide hết các dòng nhưng lại mắc lại lỗi cũ trong bài 19 bác ah.E muốn khi unhide nó trả về màu ban đầu trong vùng A10:C65536 thôi.Code này trả về màu số 0 toàn bộ sheet.

quần áo trẻ em | quan ao tre em | quần áo sơ sinh | quần áo bé trai | quần áo bé gái | bodysuit carter | quan ao so sinh | quan ao tre em nhap khau

 

[ndu96081631]

Khắc phục được không unhide hết các dòng nhưng lại mắc lại lỗi cũ trong bài 19 bác ah.E muốn khi unhide nó trả về màu ban đầu trong vùng A10:C65536 thôi.Code này trả về màu số 0 toàn bộ sheet.

Thì chổ With ActiveSheet.Range("A:A").EntireRow bạn sửa thành With ActiveSheet.Range("A10:A60000").EntireRow là được rồi
Tóm lại: muốn code hoạt động tại vùng nào, cứ sửa đỉa chỉ cho phù hợp!

 

[311280]

Thì chổ With ActiveSheet.Range("A:A").EntireRow bạn sửa thành With ActiveSheet.Range("A10:A60000").EntireRow là được rồi
Tóm lại: muốn code hoạt động tại vùng nào, cứ sửa đỉa chỉ cho phù hợp!

E đã sửa lại như bác nói nhưng nó vẫn trả các cell khác ngoài vùng đó về màu số 0.Các giá trị ngoài vùng này e có tô màu chữ nên khi sử dụng marco thì nó đưa tất cả về màu 0.Mong bác xem file đính kèm giúp e với.Thanks.

quần áo trẻ em | quan ao tre em | quần áo sơ sinh | quần áo bé trai | quần áo bé gái | bodysuit carter | quan ao so sinh | quan ao tre em nhap khau

 

[ndu96081631]

E đã sửa lại như bác nói nhưng nó vẫn trả các cell khác ngoài vùng đó về màu số 0.Các giá trị ngoài vùng này e có tô màu chữ nên khi sử dụng marco thì nó đưa tất cả về màu 0.Mong bác xem file đính kèm giúp e với.Thanks.

Ẹc... Ẹc...
Cái vụ "ngoài vùng" mà bạn nói phải quy định rõ ràng! Theo như file mới thì "ngoài vùng" là tính phía trên của A10 và bên phải của cột C, đúng không?
Vậy thì chỉ cần sửa code sao cho nó hoạt động trong khu vực A10:C60000 là được chứ nhỉ?

Private Sub CommandButton2_Click()
  With ActiveSheet.Range("A10:C65536")
    .EntireRow.Hidden = False
    .Font.Color = 0
  End With
End Sub

Với code mới này thì "trong vùng" chính là A10:C65536 ---> Bạn muốn khác hơn, tự chỉnh lấy địa chỉ nhé