Thực hiện Alt + F11 để vào code
Tạo module mới. Nhập code. Lưu và chạy macro
SubColorCompanyDuplicates()'Updateby Extendoffice 20160704DimxRg AsRangeDimxTxt AsStringDimxCell AsRangeDimxChar AsStringDimxCellPre AsRangeDimxCIndex AsLongDimxCol AsCollectionDimI AsLongOnErrorResumeNextIfActiveWindow.RangeSelection.Count > 1 ThenxTxt = ActiveWindow.RangeSelection.AddressLocalElsexTxt = ActiveSheet.UsedRange.AddressLocalEndIfSetxRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)IfxRg IsNothingThenExitSubxCIndex = 2SetxCol = NewCollectionForEachxCell InxRgOnErrorResumeNextxCol.Add xCell, xCell.TextIfErr.Number = 457 ThenxCIndex = xCIndex + 1SetxCellPre = xCol(xCell.Text)IfxCellPre.Interior.ColorIndex = xlNone ThenxCellPre.Interior.ColorIndex = xCIndexxCell.Interior.ColorIndex = xCellPre.Interior.ColorIndexElseIfErr.Number = 9 ThenMsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"ExitSubEndIfOnErrorGoTo0NextEndSub
