Lọc dữ liệu từ bảng dữ liệu cho trước. (2 người xem)

[kekeke198dn]

Mình muốn nhập ngày tháng (hình 2) tại vị trí cột G và lọc dữ liệu (hình 1) từ cột C đến cột I nếu ngày tháng giống nhau sẽ báo thông thì trùng thì mình dùng lệnh gì. Cám ơn anh em.

 

[HUONGHCKT]

Mình muốn nhập ngày tháng (hình 2) tại vị trí cột G và lọc dữ liệu (hình 1) từ cột C đến cột I nếu ngày tháng giống nhau sẽ báo thông thì trùng thì mình dùng lệnh gì. Cám ơn anh em.

Nếu vẫn còn quan tâm. thử xem code VBA sau (làm theo ý tự hiểu)
Nhấn vào nút Run code TIM_TOMAU ở Sh Lich và xem kết quả.
Các ô có ngày trùng với ngày cột G sh nt xay lap sẽ được tô màu

Sub TIM_TOMAU()
Dim i&, R&, t&, Lr&
Dim Arr(), Rng As Range, sRng As Range
With Sheets("nt xay lap")
Lr = .Cells(Rows.Count, 7).End(xlUp).Row
Arr = .Range("G6:G" & Lr).Value
End With
R = Sheets("Lich").Cells(Rows.Count, 3).End(xlUp).Row
Set Rng = Sheets("Lich").Range("C17:I" & R)
For i = 1 To UBound(Arr)
    Set sRng = Rng.Find(Arr(i, 1))
        If Not sRng Is Nothing Then
             sRng.Interior.Color = 49507
        End If
Next i
End Sub

 

[kekeke198dn]

Nếu vẫn còn quan tâm. thử xem code VBA sau (làm theo ý tự hiểu)
Nhấn vào nút Run code TIM_TOMAU ở Sh Lich và xem kết quả.
Các ô có ngày trùng với ngày cột G sh nt xay lap sẽ được tô màu

Sub TIM_TOMAU()
Dim i&, R&, t&, Lr&
Dim Arr(), Rng As Range, sRng As Range
With Sheets("nt xay lap")
Lr = .Cells(Rows.Count, 7).End(xlUp).Row
Arr = .Range("G6:G" & Lr).Value
End With
R = Sheets("Lich").Cells(Rows.Count, 3).End(xlUp).Row
Set Rng = Sheets("Lich").Range("C17:I" & R)
For i = 1 To UBound(Arr)
    Set sRng = Rng.Find(Arr(i, 1))
        If Not sRng Is Nothing Then
             sRng.Interior.Color = 49507
        End If
Next i
End Sub

Cám ơn bạn.

Nếu vẫn còn quan tâm. thử xem code VBA sau (làm theo ý tự hiểu)
Nhấn vào nút Run code TIM_TOMAU ở Sh Lich và xem kết quả.
Các ô có ngày trùng với ngày cột G sh nt xay lap sẽ được tô màu

Sub TIM_TOMAU()
Dim i&, R&, t&, Lr&
Dim Arr(), Rng As Range, sRng As Range
With Sheets("nt xay lap")
Lr = .Cells(Rows.Count, 7).End(xlUp).Row
Arr = .Range("G6:G" & Lr).Value
End With
R = Sheets("Lich").Cells(Rows.Count, 3).End(xlUp).Row
Set Rng = Sheets("Lich").Range("C17:I" & R)
For i = 1 To UBound(Arr)
    Set sRng = Rng.Find(Arr(i, 1))
        If Not sRng Is Nothing Then
             sRng.Interior.Color = 49507
        End If
Next i
End Sub

Cám ơn bạn nhiều......................

 

[Maika8008]

Nếu vẫn còn quan tâm. thử xem code VBA sau (làm theo ý tự hiểu)
Nhấn vào nút Run code TIM_TOMAU ở Sh Lich và xem kết quả.
Các ô có ngày trùng với ngày cột G sh nt xay lap sẽ được tô màu

Sub TIM_TOMAU()
Dim i&, R&, t&, Lr&
Dim Arr(), Rng As Range, sRng As Range
With Sheets("nt xay lap")
Lr = .Cells(Rows.Count, 7).End(xlUp).Row
Arr = .Range("G6:G" & Lr).Value
End With
R = Sheets("Lich").Cells(Rows.Count, 3).End(xlUp).Row
Set Rng = Sheets("Lich").Range("C17:I" & R)
For i = 1 To UBound(Arr)
    Set sRng = Rng.Find(Arr(i, 1))
        If Not sRng Is Nothing Then
             sRng.Interior.Color = 49507
        End If
Next i
End Sub

Góp ý chút:
1/ Đoạn If Not sRng Is Nothing Then ... End If của bạn dẫn đến việc tô màu cho cả ô trống đầu tiên trong vùng Sheets("Lich").Range("C17:I" & R), và nó cứ tô đi tô lại mỗi khi 1 ô trong vùng Sheets("nt xay lap").Range("G6:G" & Lr) là rỗng.
2/ Cứ mỗi giá trị trùng tìm được trong mảng thì lại phải tô màu 1 lần dẫn đến thực thi tô màu chậm đi.
Do vậy, tôi mạn phép sửa code 1 chút nhé:

Sub TIM_TOMAU()
Dim i&, R&, t&, Lr&
Dim Arr(), Rng As Range, sRng As Range, RngColor As Range, tmr
tmr = Timer()
With Sheets("nt xay lap")
Lr = .Cells(Rows.Count, 7).End(xlUp).Row
Arr = .Range("G6:G" & Lr).Value
End With
R = Sheets("Lich").Cells(Rows.Count, 3).End(xlUp).Row
Set Rng = Sheets("Lich").Range("C17:I" & R)
For i = 1 To UBound(Arr)
    Set sRng = Rng.Find(Arr(i, 1))
    On Error GoTo T1
    If Len(sRng.Value) Then  
        If RngColor Is Nothing Then
            Set RngColor = sRng
        Else
            Set RngColor = Union(sRng, RngColor)
        End If
    End If
T1:
Next i
RngColor.Interior.Color = 49507
MsgBox Timer() - tmr
End Sub

 

[HUONGHCKT]

Góp ý chút:
1/ Đoạn If Not sRng Is Nothing Then ... End If của bạn dẫn đến việc tô màu cho cả ô trống đầu tiên trong vùng Sheets("Lich").Range("C17:I" & R), và nó cứ tô đi tô lại mỗi khi 1 ô trong vùng Sheets("nt xay lap").Range("G6:G" & Lr) là rỗng.
2/ Cứ mỗi giá trị trùng tìm được trong mảng thì lại phải tô màu 1 lần dẫn đến thực thi tô màu chậm đi.
Do vậy, tôi mạn phép sửa code 1 chút nhé:

Sub TIM_TOMAU()
Dim i&, R&, t&, Lr&
Dim Arr(), Rng As Range, sRng As Range, RngColor As Range, tmr
tmr = Timer()
With Sheets("nt xay lap")
Lr = .Cells(Rows.Count, 7).End(xlUp).Row
Arr = .Range("G6:G" & Lr).Value
End With
R = Sheets("Lich").Cells(Rows.Count, 3).End(xlUp).Row
Set Rng = Sheets("Lich").Range("C17:I" & R)
For i = 1 To UBound(Arr)
    Set sRng = Rng.Find(Arr(i, 1))
    On Error GoTo T1
    If Len(sRng.Value) Then 
        If RngColor Is Nothing Then
            Set RngColor = sRng
        Else
            Set RngColor = Union(sRng, RngColor)
        End If
    End If
T1:
Next i
RngColor.Interior.Color = 49507
MsgBox Timer() - tmr
End Sub

Cảm ơn anh đã ghé xem và có nhận xét rất xác đáng.
1/Thực tình tôi cũng không tính đến đoạn mà anh đã chỉ ra đâu nên không đặt thêm If Arr(i,1)<>empty then.
2/ Tôi không có một chút kiến thức gì về Union nên Cái chỗ anh dùng Union(sRng,Rngcolor) tôi chẳng hiểu gì? Tôi sẽ tìm hiểu về Union sau.
Một lần nữa trân trọng cảm ơn anh.

 

[Maika8008]

Cảm ơn anh đã ghé xem và có nhận xét rất xác đáng.
1/Thực tình tôi cũng không tính đến đoạn mà anh đã chỉ ra đâu nên không đặt thêm If Arr(i,1)<>empty then.
2/ Tôi không có một chút kiến thức gì về Union nên Cái chỗ anh dùng Union(sRng,Rngcolor) tôi chẳng hiểu gì? Tôi sẽ tìm hiểu về Union sau.
Một lần nữa trân trọng cảm ơn anh.

Union đó chẳng qua là hợp nhất các cell, range khác nhau thành 1 range chung thôi.
- Ban đầu khi range chung chưa có (If RngColor Is Nothing Then) thì đặt nó bằng cell/range đầu tiên (Set RngColor = sRng).
- Khi range chung đã có rồi thì nối range chung với cell/range tiếp theo (Set RngColor = Union(sRng, RngColor))