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

311280 · 6/7/12

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

hoangvuluan · 6/7/12

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

Dùng tạm macro sau:

PHP:

Sub fillColor()
Dim r As Range, a(), i As Long, iR As Long, iC As Long
    Set r = ActiveSheet.Range("a5").CurrentRegion
    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).EntireRow.Font.Color = 255
                    a(i, 4) = 1
                End If
                a(j, 4) = 1
            End If
            End If
        Next
    Next
    Set r = Nothing
    Erase a
End Sub

311280 · 6/7/12

Cảm ơn bạn,Nhờ bạn chút nữa.Bạn thêm giùm code tô đỏ xong rồi ẩn những dòng không tô đi.Khi nhấn nút Commandbutton2 thì không ẩn các dòng kia nữa và trả lại màu ban đâu của những cell tô đỏ.Mình gửi file đính kèm bên dưới.

hoangvuluan · 6/7/12

311280 đã viết:
Cảm ơn bạn,Nhờ bạn chút nữa.Bạn thêm giùm code tô đỏ xong rồi ẩn những dòng không tô đi.Khi nhấn nút Commandbutton2 thì không ẩn các dòng kia nữa và trả lại màu ban đâu của những cell tô đỏ.Mình gửi file đính kèm
bên dưới.

Bạn copy mã này vào nhé!

PHP:

Private Sub CommandButton1_Click()
Dim r As Range, a(), i As Long, iR As Long, iC As Long
    Set r = ActiveSheet.Range("a10").CurrentRegion
    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).EntireRow.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
End Sub
 
Private Sub CommandButton2_Click()
Dim r As Range
    Set r = ActiveSheet.Range("a10").CurrentRegion
    r.Rows.EntireRow.Hidden = False 
   r.Rows.EntireRow.Font.Color = 0
    Set r = Nothing
End Sub

311280 · 6/7/12

buocduongcung · 6/7/12

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

Bạn có thể tham khảo link sau:
http://www.giaiphapexcel.com/forum/showthread.php?39950-Conditional-formatting

viehoai · 6/7/12

311280 đã viết:
Khi nhấn Commandbutton2 nó chưa trả những cell tô đỏ về màu ban đầu bạn ah?Tiện thể cho mình số a5 trong code có ý nghĩa như thế nào vậy?Thanks.

1.
Range("a5").CurrentRegion

Nó tương đương bạn chọn A5, sau đó nhấn Ctrl+G/Current Region
2. Bạn thêm câu lệnh sau xem sao
r.Rows.EntireRow.Font.Color = 0

311280 · 6/7/12

viehoai đã viết:
Range("a5").CurrentRegion

Nó tương đương bạn chọn A5, sau đó nhấn Ctrl G/Current Region

viehoai · 6/7/12

311280 đã viết:
Tại sao lại chọn a5 nhỉ trong khi file của mình là bắt đầu từ hàng thứ 2 mà?Mong các bác giải thích giùm.Thanks.

Nói vậy thì bạn cứ test thử biết liền, nhớ lâu hơn hỏi. Giả định các vùng rời rạc nhau xem sao v.v..

311280 · 6/7/12

viehoai đã viết:
Nói vậy thì bạn cứ test thử biết liền, nhớ lâu hơn hỏi. Giả định các vùng rời rạc nhau xem sao v.v..

Mình vừa test xong,thì marco làm việc trong A1:C65...Nay muốn nó làm việc trong A10:C65...thì sửa lại sao đây các bác?Vì 9 hàng trên mình có dữ liệu không cần tô màu theo điều kiện.VBA mình còn gà lắm.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

hoangvuluan · 6/7/12

Thì thay a5 bằng a10, a11,... a65 chẳng hạn. Mục đích là chọn 1 ô trong vùng, sau đó tự động mở rộng vùng chọn.

viehoai · 6/7/12

311280 đã viết:
Mình vừa test xong,thì marco làm việc trong A1:C65...Nay muốn nó làm việc trong A10:C65...thì sửa lại sao đây các bác?Vì 9 hàng trên mình có dữ liệu không cần tô màu theo điều kiện.VBA mình còn gà lắm.Thanks.

Nếu vậy thì thay câu lệnh

PHP:

Set r = ActiveSheet.Range("a5").CurrentRegion

Thành

PHP:

Set r = Range(ActiveSheet.Range("a10"), ActiveSheet.Range("C10").End(xlDown))

Nói chung có nhiều cách để làm, tùy thuộc vào dữ liệu của bạn

311280 · 6/7/12

hoangvuluan đã viết:
Thì thay a5 bằng a10, a11,... a65 chẳng hạn. Mục đích là chọn 1 ô trong vùng, sau đó tự động mở rộng vùng chọn.

viehoai · 6/7/12

311280 đã viết:
Bác xem giúp giùm e câu hỏi ở bài 5 với.Thanks.

Thế bạn đọc bài 7 của mình chưa?

hoangvuluan · 6/7/12

311280 đã viết:
Bác xem giúp giùm e câu hỏi ở bài 5 với.Thanks.

Bạn copy lại đoạn code ở bài #4 nhé http://www.giaiphapexcel.com/forum/...rco-tô-màu-theo-điều-kiện&p=416485#post416485

Ba Tê · 7/7/12

311280 đã viết:
Mình vừa test xong,thì marco làm việc trong A1:C65...Nay muốn nó làm việc trong A10:C65...thì sửa lại sao đây các bác?Vì 9 hàng trên mình có dữ liệu không cần tô màu theo điều kiện.VBA mình còn gà lắm.Thanks.

Thêm 1 cách làm, sử dụng 1 nút thôi (Ăn cắp của Concogia)
Trong code, [A2] là ô bắt đầu vùng dữ liệu, muôn lấy từ đâu thì sửa lại thằng [A2] này tuỳ ý.

PHP:

Public Sub An()
Dim Rng As Range, Cll As Range, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Set Rng = Sheet1.Range(Sheet1.[A2], Sheet1.[A65000].End(xlUp))
    For Each Cll In Rng
        If Not Dic.exists(Cll.Value & Cll.Offset(, 1).Value & Cll.Offset(, 2).Value) Then
            Dic.Add Cll.Value & Cll.Offset(, 1).Value & Cll.Offset(, 2).Value, ""
            Cll.Resize(, 3).Font.ColorIndex = 3
        Else
            Cll.EntireRow.Hidden = True
        End If
    Next
Set Dic = Nothing
Set Rng = Nothing
End Sub

Public Sub XONG()
With Sheet1
.Cells.EntireRow.Hidden = False
.Range(.[A2], .[A65000].End(xlUp)).Resize(, 3).Font.ColorIndex = 0
End With
End Sub

"Thọt" Con cò già 1 cái là ẩn dòng, font màu đỏ
"Đạp" Ba Tê 1 đạp là trở lại như cũ.

311280 · 9/7/12

hoangvuluan đã viết:

Bạn copy mã này vào nhé!

PHP:

Private Sub CommandButton1_Click()
Dim r As Range, a(), i As Long, iR As Long, iC As Long
    Set r = ActiveSheet.Range("a10").CurrentRegion
    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).EntireRow.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
End Sub
 
Private Sub CommandButton2_Click()
Dim r As Range
    Set r = ActiveSheet.Range("a10").CurrentRegion
    r.Rows.EntireRow.Hidden = False 
   r.Rows.EntireRow.Font.Color = 0
    Set r = Nothing
End Sub

Sau khi áp dụng mình nhờ bạn tí,Code không trả về màu ban đầu của các Cell tô đỏ mà nó chọn tất cả trong sheet trở về màu số 0.Bạn sửa giùm sau khi nhấn Commandbutton2 nó trả các cell trong vùng A10:C65536 thô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

hoangvuluan · 9/7/12

Bạn chỉ cần sửa lại như bên dưới là được.

PHP:

Private Sub CommandButton2_Click()
Dim r As Range
Set r = ActiveSheet.Range("a10:c65000")
r.Rows.EntireRow.Hidden = False
r.Rows.EntireRow.Font.Color = 0
Set r = Nothing
End Sub

311280 · 9/7/12

hoangvuluan đã viết:
Bạn chỉ cần sửa lại như bên dưới là được.

PHP:

Private Sub CommandButton2_Click() Dim r As Range Set r = ActiveSheet.Range("a10:c65000") r.Rows.EntireRow.Hidden = False r.Rows.EntireRow.Font.Color = 0 Set r = Nothing End Sub

Nhờ bác xem lại giùm e tí.Khi nhấn Commandbutton1 nó không những tô đỏ trong vùng A10:C65536,mà nó còn tô các cell khác nằm trong cột khác thuộc hàng A16 trở xuống.Nhờ bác sửa nó tô đỏ trong vùng A16:C65536 thôi.E gửi file đính kèm.

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

viehoai · 10/7/12

311280 đã viết:
Nhờ bác xem lại giùm e tí.E đã sửa theo như bác hướng dẫn nhưng vẫn còn bị lỗi đó.E gửi file đính kèm.

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

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

Người dùng đang xem chủ đề này

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

File đính kèm

Thành viên tích cực

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

File đính kèm

Thành viên tích cực

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

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên tích cực

Thành viên gắn bó

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

Thành viên gắn bó

Thành viên tích cực

Cạo Rồi Khỏi Gội

File đính kèm

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

Thành viên tích cực

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

File đính kèm

Thành viên gắn bó

Đếm ngược thời gian