Code lọc dữ liệu theo điều kiện ngày lớn nhất

[Cao Mạnh Sơn]

Tôi muốn lọc dữ liệu các đơn vị đang sản xuất các mã hàng trong 1 ngày bất kỳ, tôi đã làm bằng công thức rồi nhưng muốn dùng code VBA, tôi chỉ lọc được các giá trị ngày bằng với điều kiện.
Bây giờ tôi muốn lọc tất cả các mã hàng đang được sản xuất tại các tổ sx, đương nhiên bao gồm các mã hàng có ngày vào chuyền gần nhất so với ngày cần lọc, các giá trị ngày trước ngày gần nhất sẽ bị loại bỏ, các giá trị sau ngày cần lọc sẽ chưa được tính đến.
Tôi đã ghi chú trong file đính kèm. Mong được giúp đỡ, xin cám ơn

 

[Cao Mạnh Sơn]

ủa, sau một hồi trông tin nhưng không thấy ai trả lời hết, yêu cầu của tôi khó quá chăng

 

[PhanTuHuong]

ủa, sau một hồi trông tin nhưng không thấy ai trả lời hết, yêu cầu của tôi khó quá chăng

Thế bác đã nghiên cứu code của bác SA_DQ chưa?

 

[Cao Mạnh Sơn]

Thế bác đã nghiên cứu code của bác SA_DQ chưa?

tất nhiên tôi đã xem và cũng đã cho ý kiến , vì code giới hạn thời gian và không sử dụng được hàm Today(), tôi cũng đã nêu chi tiết thêm 1 số yêu cầu cụ thể rồi. Tôi cũng đang chờ bác SA_DQ chỉnh giúp theo mong muốn của tôi.
ai có phương án khác cố gắng giúp tôi

 

[SA_DQ]

Ái dza, chúng ta lại chờ nhau. . .

tất nhiên tôi đã xem và cũng đã cho ý kiến , (1) vì code giới hạn thời gian và (2) không sử dụng được hàm Today(), tôi cũng đã nêu chi tiết thêm 1 số yêu cầu cụ thể rồi. Tôi cũng đang chờ bác SA_DQ chỉnh giúp theo mong muốn của tôi.
ai có phương án khác cố gắng giúp tôi

Hai việc này chỉ cần sửa một chút thôi mà! Mình cứ tưởng bạn sẽ tự sửa được

Hãy xem thêm trong file đính kèm

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [c1]) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range, Clls As Range
   Dim mRng As Range, sRng1 As Range
   Dim Format_ As String
   Dim Dat As Date, Dat0 As Date, Jj As Integer '<-|'
   
   Set Sh = Sheet1:              Range("D5:D35").Clear
   Set Rng = Sh.Range(Sh.[v8], Sh.[v8].End(xlDown))
   Format_ = Rng.Cells(2, 0).NumberFormat
   Rng.NumberFormat = "MM/dd/yyyy"
   Dat0 = Format([c1].Value, "mm/dd/yyyy")
   For Jj = 0 To 366
      Dat = Dat0 - Jj
      Set sRng = Rng.Find(Dat, , xlFormulas, xlWhole)
      If Not sRng Is Nothing Then
         Set mRng = Sh.Range(sRng.Offset(, 1), Sh.Cells(sRng.Row, "iV").End(xlToLeft))
         For Each Clls In Range("B6:B17")
            Set sRng1 = mRng.Find(Clls.Value)
            If Not sRng1 Is Nothing Then
               If sRng1.Offset(, 1).Value = Clls.Offset(, 1).Value Then
                  If Clls.Offset(, 2).Value = "" Then
                     Clls.Offset(, 2).Value = Sh.Cells(sRng.Row, "C")
                     Clls.Offset(, 3).Value = Dat
                  End If
               End If
            Else
            End If
         Next Clls
      End If
   Next Jj
   Rng.NumberFormat = Format_
   On Error Resume Next
   Jj = [B4].Interior.ColorIndex
   [B4].Resize(, 3).Interior.ColorIndex = IIf(Jj > 41, 34, Jj + 1)
 End If
End Sub

 

[Cao Mạnh Sơn]

Hai việc này chỉ cần sửa một chút thôi mà! Mình cứ tưởng bạn sẽ tự sửa được

Bác ơi thời điểm này em đang học dịch code và ứng dụng được cái gì thì ứng dụng chứ chưa tự sửa code đuợc, bác đừng cười em nhé.
Để em sửa vào file dữ liệu của em cái xem kết quả đạt chưa nhé, em báo cáo kết quả sau.
To: anh Hướng:
cái anh này giỏi vác khoan đi khoan các nơi có mỗi cái việc nhỏ nhỏ này(đấy là theo ý của anh,không phải ý của tôi) vậy mà anh chỉ đứng ngoài cuộc không chịu ra tay, bữa nào gặp tôi nhất định phạt anh 1 chầu rượu mới được

 

[Cao Mạnh Sơn]

Gửi Bác SA_DQ
có 1 số điểm em sửa lại như sau:Định dạng ngày em sài dd/mm/yyyy. vì số XN và số tổ sx là thay đổi nên em thêm biến xác định dòng cuối của vùng dữ liệu Er, tại Sheet theodoi em set pass nên em thêm vào macro lệnh Unprotect, vì có mã hàng em bố trí vào chuyền từ đầu năm hoặc theo dõi liên tục sang năm sau nên giá trị Jj em gán cho đến 1000. Em muốn định dạng cột mã hàng là text để khi lọc dữ liệu xong không bị lộn xộn. Bác thêm cho em boder vùng có dữ liệu không dùng CF.
Và quan trọng hơn là kết quả chưa thoả mãn hết các điều kiện.
em gửi file đính kèm chi tiết trong file, bác giúp em nhé.

 

[SA_DQ]

Sất bất sang bang với chúng mấy ngày nay luôn đó

Option Explicit
Dim Sh As Worksheet, XiNg As Range, sRng As Range
Dim Dat As Date
Private Sub Worksheet_Change(ByVal Target As Range)
 Const SoNgay As Integer = 999
 
 If Not Intersect(Target, [D3]) Is Nothing Then
   Dim Rng As Range, Clls As Range
   Dim mRng As Range, sRng1 As Range
   Dim Addr1 As String:                         Dim Dat0 As Date
   Dim Er As Long, Jj As Integer, Dem As Integer, VTr As Byte
   ReDim Vung(SoNgay) As Range:                 ReDim MDL(SoNgay, 1)
   
   Er = Range("B65000").End(xlUp).Row:          Set XiNg = Range("B6:B" & Er)
   Set Sh = Sheets("TheoDoi"):              Range("D6:G" & Er + 10).Clear
   Set Rng = Sh.Range(Sh.[v8], Sh.[v8].End(xlDown))
   Rng.NumberFormat = "dd/mm/yyyy"
   Dat0 = Format([D3].Value, "dd/mm/yyyy")
   For Jj = 0 To SoNgay
      Dat = Dat0 - Jj
      If Dat < Sh.[V9].Value Then Exit For
      Set sRng = Rng.Find(Dat, , xlFormulas, xlWhole)
      If Not sRng Is Nothing Then
         Addr1 = sRng.Address
         Do
            Dem = Dem + 1
            Set Vung(Dem) = Sh.Range(sRng.Offset(, 1), Sh.Cells(sRng.Row, "iV").End(xlToLeft))
            MDL(Dem, 1) = Sh.Cells(sRng.Row, "C").Value
            MDL(Dem, 0) = Dat
           Set sRng = Rng.FindNext(sRng)
         Loop While Not sRng Is Nothing And sRng.Address <> Addr1
      End If
   Next Jj
   For Jj = 1 To Dem
      TimLan2 Vung(Jj), MDL(Jj, 1), MDL(Jj, 0)
   Next Jj
   Jj = [B5].Interior.ColorIndex
   [B5].Resize(, 5).Interior.ColorIndex = IIf(Jj <> 41, Jj + 1, 34)
 End If
 Range("D3").Select
End Sub

[B]Sub TimLan2(mRng As Range, MaHg As Variant, Ngay1)[/B]
 Dim Clls As Range, sRng1 As Range
 Dim Addr2 As String
 
 For Each Clls In mRng
   Set sRng1 = XiNg.Find(Clls.Value)
   If Not sRng1 Is Nothing Then
      Addr2 = sRng1.Address
      Do
         If sRng1.Offset(, 1).Value = Clls.Offset(, 1).Value Then
            If sRng1.Offset(, 3).Value = "" Then
               sRng1.Offset(, 3).Value = MaHg
               sRng1.Offset(, 2).Value = Format(Ngay1, "dd/mm/yyyy")
            ElseIf sRng1.Offset(, 2) = Format(Ngay1, "DD/mm/yyyy") And _
               sRng1.Offset(, 3).Value <> MaHg Then
               sRng1.Offset(, 4).Value = MaHg
            End If
         End If
         Set sRng1 = XiNg.FindNext(sRng1)
      Loop While Not sRng1 Is Nothing And sRng1.Address <> Addr2
   End If
 Next Clls
[B]End Sub[/B]

Xem thêm trong file đính kèm!

 

[Cao Mạnh Sơn]

Hoá ra vấn đề em hỏi không phải là đơn giản, làm bác SA_DQ ít nhất là giành 2 ngày nghỉ cuối tuần để giúp em. Cách nào để em hậu tạ bác đây?
Em mới ktra sơ bộ có 1 số vấn đề như sau:
Giá trị ngày tại cell V9 không phải là giá trị nhỏ nhất trong cột, nếu nó là ngày hôm nay thì lệnh sẽ bị thoát ra mất. Em nghĩ rằng cần phải lấy giá trị ngày nhỏ nhất trong cột ngày chuyển đổi của Sheet1.
mặc dù các định dạng ngày đã set là dd/mm/yyyy nhưng giá trị ngày trả về tại sheet2 không giống nhau, 1 số giá trị là text thì hiển thị dạng dd/mm/yyyy, một số giá trị là number thì hiển thị dạng mm/dd/yyyy em nhìn thấy hơi lộn xộn.
Em đã ktra lại code và format tất cả các vùng có chứa ngày theo dd/mm/yyyy nhưng kết quả vẫn không đạt
Bác chỉnh giúp em nhé

 

[SA_DQ]

Em mới ktra sơ bộ có 1 số vấn đề như sau:
(1) Giá trị ngày tại cell V9 không phải là giá trị nhỏ nhất trong cột, nếu nó là ngày hôm nay thì lệnh sẽ bị thoát ra mất. Em nghĩ rằng cần phải lấy giá trị ngày nhỏ nhất trong cột ngày chuyển đổi của Sheet1.

Bạn dùng dòng lệnh này thay thế cho dòng lệnh cũ:

If Dat < WorksheetFunction.Min(Rng) Then Exit For     '<=|'

Còn vụ định dạng ngày thật sự chưa biết nuốt nó bằng cách nào?

 

[PhanTuHuong]

Bác Sơn hiểu sai em rồi, em sẵ sàng giúp bác trong điều kiện trình độ cho phép ở đây này:

http://www.giaiphapexcel.com/forum/showthread.php?t=29830&page=2

 

[ChanhTQ@]

Tạm thời hãy xài cái ni, sau hẵn hay

Option Explicit
Sub DateFormat()
 Dim Clls As Range
 For Each Clls In Selection
   If Clls.Value <> "" And Application.International(xlMDY) Then
      If Right("0" & CStr(Day(Clls)), 2) > "12" Then
         Clls.Interior.ColorIndex = 35
      Else
         Clls.Value = Day(Clls) & "/" & Month(Clls) & "/" & Year(Clls)
      End If
   End If
 Next Clls
End Sub

(Chọn vùng "D530" & chạy macro)
Không chịu trách nhiệm nếu đem số liệu do macro tạo ra để tính toán tiếp theo đó!

 

[Cao Mạnh Sơn]

Tôi đã chạy thử code của bạn nhưng chạy xong nó thành bức tranh khó tả tất nhiên 1 số cell trả về định dạng dd/mm/yyyy
Mong mọi người tiếp tục giải quyết giúp vấn đề này vì tôi thấy khó hiểu ngày 1/11 cho kết quả đúng tất định dạng nhưng ngày 4/44 cho kết quả sai...???