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

  • Thread starter Thread starter 311280
  • Ngày gửi Ngày gửi
Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
3

311280

Thành viên hoạt động
Tham gia
12/7/09
Bài viết
111
Được thích
8
Nhờ các bác viết giùm e con marco,yêu cầu nằm trong file đính kèm.Thanks.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
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.
Nhấp chuột vào đây để mở rộng...

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
 
Upvote 0
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.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...

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
 
Lần chỉnh sửa cuối:
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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
 
Lần chỉnh sửa cuối:
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
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..
Nhấp chuột vào đây để mở rộng...
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
 
Lần chỉnh sửa cuối:
Upvote 0
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.
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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ũ.
 

File đính kèm

Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Lần chỉnh sửa cuối:
Upvote 0
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
 
Upvote 0
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ấp chuột vào đây để mở rộng...
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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
311280 đã viết:
Cảm ơn bác,e đã sửa lại bài 19,nhờ các bác xem giúp.
Nhấp chuột vào đây để mở rộng...

Thay 2 macro trên bằng 2 macro sau:
PHP: 
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
 
Upvote 0
hoangvuluan đã viết:
Thay 2 macro trên bằng 2 macro sau:
PHP: 
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
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
311280 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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:
PHP: 
Private Sub CommandButton2_Click()
  With ActiveSheet.Range("A:A").EntireRow
    .Hidden = False: .Font.Color = 0
  End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
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:
PHP: 
Private Sub CommandButton2_Click()
  With ActiveSheet.Range("A:A").EntireRow
    .Hidden = False: .Font.Color = 0
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
311280 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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!
 
Upvote 0
ndu96081631 đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
311280 đã viết:
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.
Nhấp chuột vào đây để mở rộng...

Ẹ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ỉ?
PHP: 
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é
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

B
Sau 1 tháng Mã Lại reset về 1 trở lên (4 người xem)
Trả lời
9
Đọc
110
Bảo_Anh_
B
T
Khóa cột cập nhật dữ liệu (4 người xem)
Trả lời
0
Đọc
13
tnkhanhvy
T
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (7 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
411
Đọc
50K
ongke0711
ongke0711
H
Đánh số thứ thự phiếu thu chi (1 người xem)
Trả lời
11
Đọc
167
HangktGTN
H
H
Tìm kiếm thông tin chi tiết trên sheet tổng hợp (1 người xem)
Trả lời
1
Đọc
53
LOGANWover
L
N
  • Question Question
Cho em hỏi về mail merge bằng vba (2 người xem)
Trả lời
3
Đọc
94
Hoàng Tuấn 868
H
T
Xin hỏi về bảng lương (2 người xem)
Trả lời
0
Đọc
53
tuandovn
T
Gà Công Nghệ
Tô màu họ và tên bị trùng từ 2 sheet khác nhau
Trả lời
6
Đọc
112
Gà Công Nghệ
Gà Công Nghệ
A
  • Question Question
Giải thích giúp mình code giải phóng bộ nhớ từ biến (2 người xem)
Trả lời
20
Đọc
9K
nguyendang95
N
Nguyenkhang2404
giúp đỡ lọc dữ liệu nâng cao (1 người xem)
Trả lời
22
Đọc
728
Phan Thế Hiệp
Phan Thế Hiệp
B
Dùng button trên forrm để gọi bàn phím ảo win 10(OSK)
Trả lời
5
Đọc
124
huhumalu
H
P
VẼ ĐƯỜNG TẦN SUẤT (DTS) TRÊN EXCEL
Trả lời
8
Đọc
194
ptm0412
ptm0412
P
GOAL SEEK NÂNG CAO TRONG EXCEL (2 người xem)
    • Thích
Trả lời
4
Đọc
205
Hoale85
H
B
Gán Phím Tắt Gọi Form (1 người xem)
Trả lời
7
Đọc
102
HeSanbi
HeSanbi
K
Điền giá trị ô thay vì địa chỉ ô
Trả lời
2
Đọc
129
LOGANWover
L
G
Chia sẻ các bạn File vẽ kèo Zamil từ excel (1 người xem)
    • Thích
    • Yêu thích
Trả lời
11
Đọc
918
trqt82
T
T
Xin trợ giúp cách lọc trùng về khoảng thời gian
Trả lời
10
Đọc
2K
Phan Thế Hiệp
Phan Thế Hiệp
L
Xin hàm trích xuất chuỗi trong ô
Trả lời
12
Đọc
212
LINH7979
L
H
[Xin giúp đỡ] Tìm thời gian trùng ở nhiều khoảng thời gian khác nhau. (1 người xem)
Trả lời
14
Đọc
2K
Phan Thế Hiệp
Phan Thế Hiệp
N
Thuế thu nhập cá nhân
    • Chấp nhận
Trả lời
3
Đọc
275
ngouyen1505
N
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom