Dùng chức năng formating thử xem. Hay bắt buộc phải code bạn?
Cảm ơn bạn đã Reply cho mình.
Có xem qua file rồi. Anh hãy nói rõ hơn việc so sánh. So sánh như nào. Từ đâu tới đâu của sheet nào? Nói chung chung quá vẫn chưa hình dung ra yêu cầu
| Sheet Form để nguyên |
| Muốn so sánh các giá trị Cột A, B, C, D, E, F tương ứng với Cột H, I, J, K ,L ,M |
| >ban đầu so sánh cột A với H + Nếu khác nhau giá trị thì tự động xuống dòng tìm đến dòng có giá trị giống bảng 1 + Sau khi khớp các giá trị ở cột A, H tiến hành so sánh các cột còn lại Nếu sai khác thì tiến hành bôi màu ạ >>>>ví dụ AB14 ở bảng 2 so sánh vởi AB14 ở bảng 1 |
| Nếu AB14 ở bảng 2 không khớp với bảng 1 thì cách xuống dòng để vị trí trùng khớp với bảng 1 |
| > Sheet Sắp xếp là kết quả mong muốn |
Tây con người ta nói chuyện vậy đó. Hổng hiểu thì lót dép đợi Tây con khác người ta hiểu.
Xem lại bảng kết quả, nếu chưa đúng thì chỉnh lại thật chính xác
Viết vầy người ta dễ hiểu hơn.
Option Explicit
Sub SAPXEP()
Dim lr&, i&, ii&, j&, rngA, rngB
Dim res(), cell As Range, cellB As Range
With Application
.ScreenUpdating = False
.CopyObjectsWithCells = False
If Evaluate("=ISREF('SAPXEP'!A1)") Then Sheets("SAPXEP").Delete
Sheets("FORM").Copy after:=Sheets("FORM")
ActiveSheet.Name = "SAPXEP"
.CopyObjectsWithCells = True
End With
lr = Cells(Rows.Count, "H").End(xlUp).Row
Range("H2:M" & lr).Sort key1:=Range("H1")
rngB = Range("H2:M" & lr).Value
lr = Cells(Rows.Count, "A").End(xlUp).Row
Range("A2:F" & lr).Sort key1:=Range("A1")
rngA = Range("A2:F" & lr).Value
ReDim res(1 To UBound(rngA), 1 To 6)
For i = 1 To UBound(rngA)
For ii = 1 To UBound(rngB)
If rngA(i, 1) = rngB(ii, 1) Then
For j = 1 To 6
res(i, j) = rngB(ii, j)
Next
End If
Next
Next
With Range("H2:M10000")
.ClearContents
.ClearFormats
End With
Range("H2").Resize(UBound(rngA), 6).Value = res
For Each cell In Range("A2:F" & lr)
Set cellB = cell.Offset(, 7): cellB.Borders.LineStyle = xlContinuous
If cell.Value <> cellB.Value Then
cell.Interior.Color = vbYellow
If Not IsEmpty(cellB) Then cellB.Interior.Color = vbYellow
End If
Next
Application.ScreenUpdating = True
End SubMình cảm ơn bạn nhé!
CẢM ƠN BÁC ĐÃ QUAN TÂM ^-^
mình đã chạy thử và rất ok luôn, cảm ơn bạn rất nhiều đã giúp đỡ mình
minh them 3 cot G,H,I va Q,R,S
