Random Posts

Đánh dấu các giá trị trùng nhau bằng những màu khác nhau bằng VBA trong Excel

(Thủ thuật VBA trong Excel)

- Đối với những người làm công việc tính toán,  thống kê thì việc phải thường xuyên làm việc với những con số trùng nhau trong 1 vùng, 1 sheet là chuyện thường xuyên gặp phải. Để tiện cho việc theo dõi, người sử dụng thường đánh dấu các giá trị trùng nhau này theo các riêng của mình. Nhưng cách thông thường mọi người thường sử dụng đó là sử dụng Conditional Formatting để tìm và định dạng các giá trị trùng nhau, nhưng với cách làm này người sử dụng chỉ có thể sử dụng được 1 màu duy nhất để phân biệt các giá trị trùng nhau. Với việc sử dụng Conditional Formatting, người sử dụng vẫn khó theo dõi trong 1 vùng có nhiều giá trị giống nhau do chỉ có 1 màu để phân biệt. Vậy có cách nào để có thể thể hiện mỗi giá trị trùng nhau là một màu riêng biệt không?

Xem những Video hay dành cho thiếu nhi - Xem trên Youtube


Hôm nay Kênh phần mềm việt sẽ giới thiệu với mọi người sử dụng VBA để đánh dấu các giá trị trùng nhau bằng những màu khác nhau.

B1: Khởi động Microsoft Excel.
B2: Nhấn ALT + F11 để bắt đầu Visual Basic Editor.
B3: Vào Menu Inser\Module


B4: Nhập toàn bộ đoạn mã sau vào

Sub Highlight_Duplicate()
    Dim ws As Worksheet
    Dim cell As Range
    Dim myrng As Range
    Dim clr As Long
    Dim lastcell As Range
    Dim i As Long
    Dim lastrow As Long

    Set ws = ThisWorkbook.ActiveSheet

    'Vung can danh dau gia tri trung nhau
    Set myrng = ws.Range("C4:F" & Range("C" & ws.Rows.Count).End(xlUp).Row)

    With myrng
        Set lastcell = .Cells(.Cells.Count)
    End With

    myrng.Interior.ColorIndex = xlNone
    clr = 3

    For Each cell In myrng
        'Kiem tra so gia tri trung nhau trong vung, neu co hai gia tri trung nhau tro len thi thuc hien
        If Application.WorksheetFunction.CountIf(myrng, cell) > 1 Then
            'Neu la o dau tien cua cac gia tri trung nhau trong vung
            If myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastcell).Address = cell.Address Then
                'Thiet lap mau
                cell.Interior.ColorIndex = clr
                clr = clr + 1
                i = i + 1
            Else
                'Thiet lap mau tu o thu 2 voi cac gia tri trung nhau
                cell.Interior.ColorIndex = myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastcell).Interior.ColorIndex
            End If
        End If
    Next

     'Lay dong cuoi cung cua vung du lieu
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & lastrow + 2).Value = "Tong so co " & i & " gia tri trung nhau"
End Sub

Trong ví dụ này, Kênh phần mềm đang để vùng cần đánh dấu từ cột C: F, các bạn có thể thay đổi địa chỉ của vùng này tùy vào dữ liệu thực tế.

B5: Chạy Macro có tên Highlight_Duplicate

Tin học văn phòng

Post a Comment

0 Comments