Tô màu vùng kết quả vửa tìm kiếm (1 người xem)

[lhthai]

Hiện tại đang su dụng code sau
Muốn sau khi cho kết quả tại ô sẽ có màu vàng chữ đỏ.

Private Sub CommandButton1_Click()
Dim Arr(), i As Long, Rng As Range
Arr = Range("G7", [G65536].End(xlUp)).Resize(, 4).Value
For i = 1 To UBound(Arr, 1)
Set Rng = Range("B:B").Find(Arr(i, 1), , , xlWhole)
If Not Rng Is Nothing Then
        Arr(i, 3) = Rng.Offset(, 3)
           End If
           Next
           Range("G7").Resize(i - 1, 3) = Arr
End Sub

 

[hitoko]

bác record 1 cái marco tô màu chữ và fill màu cell ... vậy là bác có code tô màu ... thêm vào code cho thích hợp là xong!

 

[SA_DQ]

Theo mình thì có 2 cách để xử vụ này tùy thuộc vô độ lớn CSDL của bạn;

Nếu nó là lớn thì làm như bạn & thêm bước nữa là duyệt cột kết quả để định dạng từng ô thỏa iêu cầu;

Bằng ngược lại thì ta tìm thấy thì ghi xuống trang tính & định dạng luôn ô đó nếu thỏa điều kiện để định dạng. (Không ghi vô mảng nữa)

 

[lhthai]

Theo mình thì có 2 cách để xử vụ này tùy thuộc vô độ lớn CSDL của bạn;

Nếu nó là lớn thì làm như bạn & thêm bước nữa là duyệt cột kết quả để định dạng từng ô thỏa iêu cầu;

Bằng ngược lại thì ta tìm thấy thì ghi xuống trang tính & định dạng luôn ô đó nếu thỏa điều kiện để định dạng. (Không ghi vô mảng nữa)

CLDL của mình khoảng 3000 dòng thì dùng cách nào vậy bạn
Bạn có thể hướng dẫn thêm không
Cám ơn bạn.

 

[doveandrose]

cái mã 9C-1650-014 đâu có tìm thấy sao ra được Quantity = 1000 vậy ?

 

[lhthai]

cái mã 9C-1650-014 đâu có tìm thấy sao ra được Quantity = 1000 vậy ?

3 mã mà có số lượng 1000,2000,600 là mình đổi để test màu thôi.

 

[lhthai]

Theo mình thì có 2 cách để xử vụ này tùy thuộc vô độ lớn CSDL của bạn;

Nếu nó là lớn thì làm như bạn & thêm bước nữa là duyệt cột kết quả để định dạng từng ô thỏa iêu cầu;

Bằng ngược lại thì ta tìm thấy thì ghi xuống trang tính & định dạng luôn ô đó nếu thỏa điều kiện để định dạng. (Không ghi vô mảng nữa)

Nhờ bạn bổ sung dùm phần điều kiện nếu kết quả nào có thì định dạng còn không thì giữ nguyên.

Private Sub CommandButton2_Click()
Dim Arr(), i As Long, Rng As Range, Darr()
Arr = Range("G7", [G65536].End(xlUp)).Resize(, 4).Value
ReDim Darr(1 To UBound(Arr), 1 To 1)
For i = 1 To UBound(Arr, 1)
Set Rng = Range("B:B").Find(Arr(i, 1), , , xlWhole)
If Not Rng Is Nothing Then
        Arr(i, 3) = Rng.Offset(, 3)
           End If
           Next
  For i = 1 To UBound(Arr, 1)
        Darr(i, 1) = Arr(i, 3)
        Next
        Range("I7:I1000").Interior.ColorIndex = 0
        Range("I7:I1000").Font.ColorIndex = 0
        Range("I7:I1000").Font.Bold = False
        Range("I7").Resize(i - 1) = Darr
        Range("I7").Resize(i - 1).Interior.ColorIndex = 6
        Range("I7").Resize(i - 1).Font.Color = 255
        Range("I7").Resize(i - 1).Font.Bold = True
End Sub

 

[Ba Tê]

Nhờ bạn bổ sung dùm phần điều kiện nếu kết quả nào có thì định dạng còn không thì giữ nguyên.

Private Sub CommandButton2_Click()
Dim Arr(), i As Long, Rng As Range, Darr()
Arr = Range("G7", [G65536].End(xlUp)).Resize(, 4).Value
ReDim Darr(1 To UBound(Arr), 1 To 1)
For i = 1 To UBound(Arr, 1)
Set Rng = Range("B:B").Find(Arr(i, 1), , , xlWhole)
If Not Rng Is Nothing Then
        Arr(i, 3) = Rng.Offset(, 3)
           End If
           Next
  For i = 1 To UBound(Arr, 1)
        Darr(i, 1) = Arr(i, 3)
        Next
        Range("I7:I1000").Interior.ColorIndex = 0
        Range("I7:I1000").Font.ColorIndex = 0
        Range("I7:I1000").Font.Bold = False
        Range("I7").Resize(i - 1) = Darr
        Range("I7").Resize(i - 1).Interior.ColorIndex = 6
        Range("I7").Resize(i - 1).Font.Color = 255
        Range("I7").Resize(i - 1).Font.Bold = True
End Sub

Đọc code của bạn không hiểu.
Chạy thử code này với dữ liệu vài ngàn dòng xem sao

Public Sub GPE()
Application.ScreenUpdating = False
Dim Dic As Object, sArr(), Rng As Range, Cll As Range, I As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
Set Rng = Range([G7], [G7].End(xlDown))
sArr = Range([B7], [B7].End(xlDown)).Resize(, 4).Value
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 4)
    If Not Dic.Exists(Tem) Then Dic.Add Tem, Empty
Next I
With Rng.Offset(, 2)
    .Interior.ColorIndex = 0
    .Font.ColorIndex = 0
    .Font.Bold = False
End With
For Each Cll In Rng
    Tem = Cll & "#" & Cll.Offset(, 1) & "#" & Cll.Offset(, 2)
    If Dic.Exists(Tem) Then
        With Cll.Offset(, 2)
            .Interior.ColorIndex = 6
            .Font.ColorIndex = 3
            .Font.Bold = True
        End With
    End If
Next
Set Dic = Nothing
Set Rng = Nothing
End Sub

 

[lhthai]

Đọc code của bạn không hiểu.
Chạy thử code này với dữ liệu vài ngàn dòng xem sao

Public Sub GPE()
Application.ScreenUpdating = False
Dim Dic As Object, sArr(), Rng As Range, Cll As Range, I As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
Set Rng = Range([G7], [G7].End(xlDown))
sArr = Range([B7], [B7].End(xlDown)).Resize(, 4).Value
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 4)
    If Not Dic.Exists(Tem) Then Dic.Add Tem, Empty
Next I
With Rng.Offset(, 2)
    .Interior.ColorIndex = 0
    .Font.ColorIndex = 0
    .Font.Bold = False
End With
For Each Cll In Rng
    Tem = Cll & "#" & Cll.Offset(, 1) & "#" & Cll.Offset(, 2)
    If Dic.Exists(Tem) Then
        With Cll.Offset(, 2)
            .Interior.ColorIndex = 6
            .Font.ColorIndex = 3
            .Font.Bold = True
        End With
    End If
Next
Set Dic = Nothing
Set Rng = Nothing
End Sub

Ý của mình nếu cột I có cập nhật mới thì đổi màu,còn những ô không thay đổi thì giữ nguyên.
Cám ơn Anh nhiều.