Giá trị nào của cột C được lặp lại quá 2 lần thì toàn bộ dòng tương ứng sẽ bôi màu đỏ (1 người xem)

LinDan · 13/2/12

Tôi đang cần kiểm tra, đối chiếu các tài khoản đối ứng trên bảng CĐKT,

Yêu cầu đặt ra là nếu giá trị cột C nào xuất hiện quá 2 lần trở lên thì toàn bộ dòng đó sẽ được bôi chữ màu đỏ. Xin gửi file đính kèm, nhờ các bạn giúp

dhn46 · 13/2/12

Bạn có thể sử dụng condition fomating với công thức cho vùng có dữ liệu $A$1:$A$15

ví dụ: =COUNTIF($A$1:$A$15,$A1)>1

(tôi không đọc được file xlsx)

LinDan · 13/2/12

dhn46 đã viết:
Bạn có thể sử dụng condition fomating với công thức cho vùng có dữ liệu $A$1:$A$15

ví dụ: =COUNTIF($A$1:$A$15,$A1)>1

(tôi không đọc được file xlsx)

Tôi vừa gửi file bản 2003, bác xem giúp hộ nhé.

dhn46 · 13/2/12

của bạn đây, bạn kiểm tra nhé

hoangminhtien · 13/2/12

Bạn xem trong file đính kèm nhé! công thức trong CF là

=COUNTIF($C$3:$C$10,$C3)>1

LinDan · 13/2/12

Các cách làm trên quá chuẩn rồi, nhưng nếu bài này mà làm bằng VBA thì ta viết thế nào?

dhn46 · 13/2/12

Bạn thử code này xem

Mã:

Sub Button1_Click()
Dim cls As Range
For Each cls In [c3:c10]
    For i = 3 To 10
        If cls = Cells(i, 3) And cls.Row <> i Then
            Range(Cells(i, 1), Cells(i, 3)).Font.ColorIndex = 3
        End If
    Next
Next
End Sub

(Các bài viết không đáng tks sao?)

ndu96081631 · 13/2/12

LinDan đã viết:
Các cách làm trên quá chuẩn rồi, nhưng nếu bài này mà làm bằng VBA thì ta viết thế nào?

1> Copy 2 đoạn code này vào 1 Module

PHP:

Sub sRowColor(ByVal SrcRng As Range, ByVal Color As Long)
  Dim Dic As Object, tmpArr, tmpRow(), tmp, Arr(), lR As Long, lC As Long
  On Error Resume Next
  SrcRng.Font.ColorIndex = -4105
  tmpArr = SrcRng.Value
  Set Dic = CreateObject("Scripting.Dictionary")
  For lR = 1 To UBound(tmpArr, 1)
    If tmpArr(lR, 1) <> "" Then
      ReDim tmpRow(1 To UBound(tmpArr, 2))
      For lC = 1 To UBound(tmpArr, 2)
        tmpRow(lC) = tmpArr(lR, lC)
      Next
      tmp = Join(tmpRow, "")
      If Trim(tmp) <> "" Then
        tmp = Join(tmpRow, Chr(0))
        If Not Dic.Exists(tmp) Then
          Dic.Add tmp, lR
        Else
          SrcRng.Rows(Dic.Item(tmp)).Font.ColorIndex = Color
          SrcRng.Rows(lR).Font.ColorIndex = Color
        End If
      End If
    End If
  Next
End Sub

PHP:

Sub Main()
  Dim SrcRng As Range
  On Error Resume Next
  Set SrcRng = Selection
  sRowColor SrcRng, 3
End Sub

2> Quét chọn vùng dữ liệu cần tô màu rồi bấm Alt + F8, chạy Sub Main
------------------
Code này cho phép tô màu dữ liệu trùng trên nhiều cột (có thể cải tiến thêm cho nó tô màu nhiều cột nhưng không nằm liên tục nhau)

LinDan · 13/2/12

dhn46 đã viết:
Bạn thử code này xem

Mã:

Sub Button1_Click() Dim cls As Range For Each cls In [c3:c10] For i = 3 To 10 If cls = Cells(i, 3) And cls.Row <> i Then Range(Cells(i, 1), Cells(i, 3)).Font.ColorIndex = 3 End If Next Next End Sub

(Các bài viết không đáng tks sao?)

Nếu bài toán mở rộng là:
Đối với các ô có giá trị bằng nhau (được lặp lại từ 2 lần trở lên) sẽ được tô cùng màu.
Các ô có giá trị khác nhau (vẫn đảm bảo điều kiện lặp từ 2 lần trở lên) thì tô khác màu.

(Số lượng màu dùng để tô có thể lấy ngẫu nhiên).

Liệu bài toán này có thể làm được không

concogia · 13/2/12

LinDan đã viết:
Nếu bài toán mở rộng là:
Đối với các ô có giá trị bằng nhau (được lặp lại từ 2 lần trở lên) sẽ được tô cùng màu.
Các ô có giá trị khác nhau (vẫn đảm bảo điều kiện lặp từ 2 lần trở lên) thì tô khác màu.

(Số lượng màu dùng để tô có thể lấy ngẫu nhiên).

Liệu bài toán này có thể làm được không

Được, khoảng 50 màu thôi thì Ok
Xem thử trong file
Thân

cadafi · 13/2/12

LinDan đã viết:
Các cách làm trên quá chuẩn rồi, nhưng nếu bài này mà làm bằng VBA thì ta viết thế nào?

Quét chọn vùng dữ liệu rồi ấn Alt+F8 chạy thử code này nhé bạn.

PHP:

Sub FormatColumnC()
With Selection
.FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF($C:$C,$C1)>1"
.FormatConditions(1).Interior.ThemeColor = xlThemeColorAccent6
End With
End Sub

LinDan · 13/2/12

Code của thày Ndu

PHP:

Sub sRowColor(ByVal SrcRng As Range, ByVal Color As Long)
  Dim Dic As Object, tmpArr, tmpRow(), tmp, Arr(), lR As Long, lC As Long
  On Error Resume Next
  SrcRng.Font.ColorIndex = -4105
  tmpArr = SrcRng.Value
  Set Dic = CreateObject("Scripting.Dictionary")
  For lR = 1 To UBound(tmpArr, 1)
    If tmpArr(lR, 1) <> "" Then
      ReDim tmpRow(1 To UBound(tmpArr, 2))
      For lC = 1 To UBound(tmpArr, 2)
        tmpRow(lC) = tmpArr(lR, lC)
      Next
      tmp = Join(tmpRow, "")
      If Trim(tmp) <> "" Then
        tmp = Join(tmpRow, Chr(0))
        If Not Dic.Exists(tmp) Then
          Dic.Add tmp, lR
        Else
          SrcRng.Rows(Dic.Item(tmp)).Font.ColorIndex = Color
          SrcRng.Rows(lR).Font.ColorIndex = Color
        End If
      End If
    End If
  Next
End Sub

và

PHP:

Sub Main()
  Dim SrcRng As Range
  On Error Resume Next
  Set SrcRng = Selection
  sRowColor SrcRng, 3
End Sub

Tôi xin phép được hỏi:
SrcRng có nghĩa là gì thế?
ReDim tmpRow(1 To UBound(tmpArr, 2))thì nó làm mảng dọc hay là mảng ngang hay là mảng 2 chiều.

trungvdb · 13/2/12

ndu96081631 đã viết:
1> Copy 2 đoạn code này vào 1 Module

PHP:

Sub sRowColor(ByVal SrcRng As Range, ByVal Color As Long) Dim Dic As Object, tmpArr, tmpRow(), tmp, Arr(), lR As Long, lC As Long On Error Resume Next SrcRng.Font.ColorIndex = -4105 tmpArr = SrcRng.Value Set Dic = CreateObject("Scripting.Dictionary") For lR = 1 To UBound(tmpArr, 1) If tmpArr(lR, 1) <> "" Then ReDim tmpRow(1 To UBound(tmpArr, 2)) For lC = 1 To UBound(tmpArr, 2) tmpRow(lC) = tmpArr(lR, lC) Next tmp = Join(tmpRow, "") If Trim(tmp) <> "" Then tmp = Join(tmpRow, Chr(0)) If Not Dic.Exists(tmp) Then Dic.Add tmp, lR Else SrcRng.Rows(Dic.Item(tmp)).Font.ColorIndex = Color SrcRng.Rows(lR).Font.ColorIndex = Color End If End If End If Next End Sub

PHP:

Sub Main() Dim SrcRng As Range On Error Resume Next Set SrcRng = Selection sRowColor SrcRng, 3 End Sub

2> Quét chọn vùng dữ liệu cần tô màu rồi bấm Alt + F8, chạy Sub Main
------------------
Code này cho phép tô màu dữ liệu trùng trên nhiều cột (có thể cải tiến thêm cho nó tô màu nhiều cột nhưng không nằm liên tục nhau)

Sao tôi chạy nó không được nhỉ? Xin thày Ndu và mọi người hướng dẫn cho

ndu96081631 · 13/2/12

trungvdb đã viết:
Sao tôi chạy nó không được nhỉ? Xin thày Ndu và mọi người hướng dẫn cho

Phải quét chọn vùng rồi mới chạy code chứ (vì đã Set SrcRng = Selection rồi còn gì)

trungvdb · 13/2/12

ndu96081631 đã viết:
Phải quét chọn vùng rồi mới chạy code chứ (vì đã Set SrcRng = Selection rồi còn gì)

Xin nhờ thày giảng hộ cho:
- Tại sao Sub Main nó lại điều khiển được Sub sRowColor (có link)?. Sự liên kết của chúng thể hiện ở dòng nào hả thày?
- sRowColor SrcRng, 3 là gì thế hả thày (chắc gán đối tượng gì gì đó cho nó màu đỏ)?

Vì nhiều cái chưa biết, rất mong thày giải thích giúp.

Tôi cũng có làm như thày bảo mà, tức là Chọn vùng (A1:C9), sau đó ấn Alt+F8 chạy Sub Main nhưng không thấy bôi màu.

ndu96081631 · 13/2/12

trungvdb đã viết:
Xin nhờ thày giảng hộ cho:
- Tại sao Sub Main nó lại điều khiển được Sub sRowColor (có link)?. Sự liên kết của chúng thể hiện ở dòng nào hả thày?
- sRowColor SrcRng, 3 là gì thế hả thày (chắc gán đối tượng gì gì đó cho nó màu đỏ)?

Vì nhiều cái chưa biết, rất mong thày giải thích giúp.

Sự liên kết này cũng giống như bạn viết 1 hàm trong VBA rồi gõ lên bảng tính thôi
- Hàm tự tạo có các tham số
- Khi gõ vào bảng tính, ta sẽ "truyền" các tham số vào bằng các giá trị cụ thể
- Với Sub có tham số truyền (nhu Sub sRowColor) cũng vậy thôi ---> Nó gồm 2 tham số: SrcRng (vùng dữ liệu) và Color (màu tùy chọn)... Giờ bạn đăt SrcRng là vùng nào, với màu nào tùy bạn, nó sẽ chạy thôi
----------------------

trungvdb đã viết:
Tôi cũng có làm như thày bảo mà, tức là Chọn vùng (A1:C9), sau đó ấn Alt+F8 chạy Sub Main nhưng không thấy bôi màu.

Vùng A1:C9 chẳng có dòng nào trùng với dòng nào cả, lấy đâu mà tô ---> Thử copy A1:C1 và paste vào A5:C5 rồi chạy lại code xem

trungvdb · 13/2/12

ndu96081631 đã viết:
Sự liên kết này cũng giống như bạn viết 1 hàm trong VBA rồi gõ lên bảng tính thôi
- Hàm tự tạo có các tham số
- Khi gõ vào bảng tính, ta sẽ "truyền" các tham số vào bằng các giá trị cụ thể
- Với Sub có tham số truyền (nhu Sub sRowColor) cũng vậy thôi ---> Nó gồm 2 tham số: SrcRng (vùng dữ liệu) và Color (màu tùy chọn)... Giờ bạn đăt SrcRng là vùng nào, với màu nào tùy bạn, nó sẽ chạy thôi
----------------------

Vùng A1:C9 chẳng có dòng nào trùng với dòng nào cả, lấy đâu mà tô ---> Thử copy A1:C1 và paste vào A5:C5 rồi chạy lại code xem

Chạy rất tốt rồi ah, hóa ra cái này thày viết cho cả dòng, thế nên mới có Joint Jonit gì đó (đoán vậy chứ Joint chưa biết bao giờ, chỉ thấy dịch sang VN nghĩa là nối thôi), chứ không phải cho cột C

Tối nay lại có cái mới để nghiên cứu rồi

trungvdb · 13/2/12

Tôi thắc mắc là cú pháp: sRowColor SrcRng, 3 thì tại sao máy lại hiểu thành phần thứ 3 (tức là số 3) là đặc tính màu của vùng đó, mà không phải là các đặc tính của vùng như Font chữ, cỡ chữ nhỉ?

Hay là nó nhận biết đặc tính đó được gán cho màu do nguyên nhân phụ thuộc vào từ Color (trong câu Sub sRowColor(ByVal SrcRng As Range, ByVal Color As Long?).

trungvdb · 13/2/12

Học theo thày Ndu, định áp dụng cho vùng A1:C10, áp dụng tìm giá trị trong cột C như đầu bài của Topic, nhưng không chưa thành công, rất mong nhận được sự chỉ bảo của mọi người về phương thức này

PHP:

Sub sRowColor(ByVal Vungchon As Range, ByVal Color As Long)
  Dim Dic As Object, DL, tmpRow(), Tmp, i As Long
  On Error Resume Next
  Vungchon.Font.ColorIndex = -4105
  DL = Vungchon.Value
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(DL, 1)
    If DL(i, 3) <> "" Then
        Tmp = DL(i, 3)
            If Not Dic.Exits(Tmp) Then
                Dic.Add Tmp, i
                Else
                  Vungchon.Rows(Dic.Item(Tmp)).Font.ColorIndex = Color
                  Vungchon.Rows(i).Font.ColorIndex = Color
            End If
    End If
Next
End Sub

và Code

PHP:

Sub DMain()
  Dim Vungchon As Range
  On Error Resume Next
  Set Vungchon = Range("A1:C10")
    sRowColor Vungchon, 3
End Sub

ndu96081631 · 13/2/12

trungvdb đã viết:
Chạy rất tốt rồi ah, hóa ra cái này thày viết cho cả dòng, thế nên mới có Joint Jonit gì đó (đoán vậy chứ Joint chưa biết bao giờ, chỉ thấy dịch sang VN nghĩa là nối thôi), chứ không phải cho cột C Tối nay lại có cái mới để nghiên cứu rồi

Chính xác là vậy! Join(Mảng, dấu phân cách) sẽ nối các phần tử trong mảng với nhau bằng dấu phân cách ---------- Muốn dùng cho cột C thì quét chọn cột C thôi Ẹc... Ẹc...

trungvdb · 13/2/12

ndu96081631 đã viết:
Chính xác là vậy!
Join(Mảng, dấu phân cách) sẽ nối các phần tử trong mảng với nhau bằng dấu phân cách
----------
Muốn dùng cho cột C thì quét chọn cột C thôi
Ẹc... Ẹc...

Trời, bài của thày tổng quát, muốn đơn giản cột nào thì chọn cột đó thôi, đơn giản vậy mà tôi không nghĩ được, cảm ơn thày rất nhiều.

Nhưng do những cái này chưa biết, nghiên cứu cũng rất tốt, vừa rồi có mạo muội làm thử xem như bài trên nhưng chạy không ra được kết quả, xin thày chỉ cho chỗ sai.

ndu96081631 · 13/2/12

trungvdb đã viết:
Tôi thắc mắc là cú pháp: sRowColor SrcRng, 3 thì tại sao máy lại hiểu thành phần thứ 3 (tức là số 3) là đặc tính màu của vùng đó, mà không phải là các đặc tính của vùng như Font chữ, cỡ chữ nhỉ?

Hay là nó hiểu được là do cái từ Color trong câu Sub sRowColor(ByVal SrcRng As Range, ByVal Color As Long?

Nó hiểu nhờ vào câu này
SrcRng.Rows(Dic.Item(tmp)).Font.ColorIndex = Color
Tức đặt thuộc tính Font.ColorIndex của vùng SrcRng.Rows(Dic.Item(tmp)) chính bằng biến Color tức cho biến Color bằng bao nhiêu thì vùng SrcRng.Rows(Dic.Item(tmp)) sẽ "theo" màu như vậy
Để biết màu nào "ăn" với số nào, có thể thí nghiệm bằng code:

PHP:

Sub Test()
 Dim i As Long
 For i = 1 To 56
   Cells(i, 1).Interior.ColorIndex = i
 Next
End Sub

Lưu ý
- Vung.Interior.ColorIndex là muốn nói đến màu nền
- Vung.Font.ColorIndex là muốn nói đến màu font chữ

trungvdb đã viết:
Nhưng do những cái này chưa biết, nghiên cứu cũng rất tốt, vừa rồi có mạo muội làm thử xem như bài trên nhưng chạy không ra được kết quả, xin thày chỉ cho chỗ sai.

Sub có tham số truyền phải tổng quat, tức không được chỉ đến chính xác 1 vùng nào cả (khi nào xài mới "truyền")
Trong khi đó code của bạn lại có đoạn If DL(i, 3) <> "" Then thế hóa ra "buộc" phải luôn luôn làm việc với cột thứ 3 của Vung à? Vô lý! Nếu thế thì thà rằng viết 1 Sub bình thường cho rồi ---> "Truyền nước biển" làm gì cho mất công

trungvdb · 13/2/12

Như vậy hiểu thế này có đúng không ah:

Những từ Color (được bôi màu đỏ) trong các câu:

+ SrcRng.Rows(Dic.Item(tmp)).Font.ColorIndex = Color.
+ Sub sRowColor(ByVal SrcRng As Range, ByVal Color As Long)

Phải hoàn toàn giống nhau và không được thay thế bằng từ khác? (vì nó là từ cứng được định nghĩa trong VBA)?

trungvdb · 13/2/12

ndu96081631 đã viết:
Sub có tham số truyền phải tổng quat, tức không được chỉ đến chính xác 1 vùng nào cả (khi nào xài mới "truyền")
Trong khi đó code của bạn lại có đoạn If DL(i, 3) <> "" Then thế hóa ra "buộc" phải luôn luôn làm việc với cột thứ 3 của Vung à? Vô lý! Nếu thế thì thà rằng viết 1 Sub bình thường cho rồi ---> "Truyền nước biển" làm gì cho mất công

Vâng, cái này tôi chưa biết, nghe thày giảng tôi đã làm được rồi

PHP:

Sub Tomau()
 Dim Vung, DL(), i As Long, dongcuoi As Long
 Set Dic = CreateObject("Scripting.Dictionary")
  dongcuoi = [C65000].End(xlUp).Row
 Set Vung = Range("A1:C" & dongcuoi)
 DL = Vung.Value
 For i = 1 To UBound(DL, 1)
    If DL(i, 3) <> "" Then
      Tmp = DL(i, 3)
        If Not Dic.Exists(Tmp) Then
            Dic.Add Tmp, i
            Else
            Vung.Rows(Dic.Item(Tmp)).Font.ColorIndex = 3
            Vung.Rows(i).Font.ColorIndex = 3
        End If
    End If
  Next
  
 End Sub

* Qua bài này bản thân học được ở thày tình huống rất hay:

Vung.Rows(Dic.Item(Tmp)).Font.ColorIndex = 3
Vung.Rows(i).Font.ColorIndex = 3

Thế mới biết thằng "Đít" này lợi hại gớm, nếu sáng tạo ra thì nó có thể ứng dụng vào giải quyết rất nhiều bài chứ không chỉ đơn thuần là lọc duy nhất.

Cứ hôm nào vào GPE xem học những bài giải của thày thì bản thân lại học được ở thày những kiến thức vô cùng quý báu, xin chân thành cảm ơn thày rất nhiều.

ndu96081631 · 13/2/12

trungvdb đã viết:
Như vậy hiểu thế này có đúng không ah:

Những từ Color (được bôi màu đỏ) trong các câu:

+ SrcRng.Rows(Dic.Item(tmp)).Font.ColorIndex = Color.
+ Sub sRowColor(ByVal SrcRng As Range, ByVal Color As Long)

Phải hoàn toàn giống nhau và không được thay thế bằng từ khác? (vì nó là từ cứng được định nghĩa trong VBA)?

Ah... không!
Cái màu đỏ ấy chỉ là tên biến, bạn thích thì cứ thay thành bất cứ từ nào cũng được
Đương nhiên, nếu tham số trong Sub bạn đặt tên là Mau
Sub sRowColor(ByVal SrcRng As Range, ByVal Mau As Long)
thì ở dưới cũng phải viết tên biến giống vậy
SrcRng.Rows(Dic.Item(tmp)).Font.ColorIndex = Mau
-------------------

trungvdb đã viết:
Thế mới biết thằng "Đít" này lợi hại gớm, nếu sáng tạo ra thì nó có thể ứng dụng vào giải quyết rất nhiều bài chứ không chỉ đơn thuần là lọc duy nhất.

Không cần phải là bài toán LỌC DUY NHẤT, miễn sao có yếu tố DUY NHẤT hoặc yếu tố TỒN TẠI, KHÔNG TỒN TẠI trong đó là ta có thể nghĩ đến Dictionary (trong bài tô màu này là xét đến yếu tố tồn tại)
Ẹc... Ẹc....

trungvdb · 13/2/12

Thành phần SrcRng.Font.ColorIndex = -4105 thày đưa vào nó có ý nghĩa gì thế?

Hoàng Trọng Nghĩa · 13/2/12

trungvdb đã viết:
Thành phần SrcRng.Font.ColorIndex = -4105 thày đưa vào nó có ý nghĩa gì thế?

Đó là thuộc tính của Range, với biến SrcRng khi khai báo nó đại diện cho Range, và đã là Range thì nó có nhiều thuộc tính của Range, như trên có thể hiểu rằng vùng nào đó thuộc SrcRng sẽ có Font hệ số màu là -4105

ndu96081631 · 13/2/12

trungvdb đã viết:
Thành phần SrcRng.Font.ColorIndex = -4105 thày đưa vào nó có ý nghĩa gì thế?

Đương nhiên đâu tiên vào phải xóa hết các màu sắc nếu có của cell, xong rồi mới tô chứ, đúng không?
SrcRng.Font.ColorIndex = -4105 là trả màu của vùng SrcRng thành Automatic! thế thôi

Giá trị nào của cột C được lặp lại quá 2 lần thì toàn bộ dòng tương ứng sẽ bôi màu đỏ (1 người xem)

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

Thành viên tiêu biểu

File đính kèm

Hướng tới tương lai

Thành viên tiêu biểu

Hướng tới tương lai

File đính kèm

Thành viên gắn bó

File đính kèm

Thành viên tiêu biểu

Hướng tới tương lai

Huyền thoại GPE

Thành viên tiêu biểu

File đính kèm

Gội rồi mới Cạo

File đính kèm

Hành động từ trái tim

Thành viên tiêu biểu

Thành viên thường trực

Huyền thoại GPE

Thành viên thường trực

Huyền thoại GPE

Thành viên thường trực

Thành viên thường trực

Thành viên thường trực

Huyền thoại GPE

Thành viên thường trực

Huyền thoại GPE

Thành viên thường trực

Thành viên thường trực

Huyền thoại GPE

Thành viên thường trực

Chuyên gia GPE

Huyền thoại GPE

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