Nhập dữ liệu theo điều kiện ? (1 người xem)

[Hoàng Nhật Phương]

Xin chào các bạn,
Tôi đang vướng mắc vấn đề đưa dữ liệu tự động vào bảng bảng tính, theo điều kiện ngàytháng.
Cụ thể chi tiết tôi nêu trong tập tin trong link kèm bên dưới:

http://www.mediafire.com/file/hapqx0ukalbck5d/nhaplieu.xlsb

Nhờ các bạn xem file và giúp đỡ cho ạ.

 

[befaint]

Sub BKLO()
Application.ScreenUpdating = False
Dim DK As Variant, z As Long, r As Long, KL() As Variant, BO() As Variant
Dim d1 As Long, d2 As Long, D As Variant, tmp As Variant, chk As Boolean
d1 = CLng(Sheet3.Range("H2").Value2): d2 = CLng(Sheet3.Range("J2").Value2)
With Sheet1
    .AutoFilterMode = False
    z = .Range("D" & .Rows.Count).End(xlUp).Row
    DK = .Range("M5:M" & z).Value2: z = UBound(DK, 1)
    ReDim KL(1 To z, 1 To 2): ReDim BO(1 To z, 0)
    For r = 1 To z
        D = DK(r, 1)
          If D <> Empty Then
            D = CLng(D)
            If d1 <= D And D <= d2 Then
                chk = True
                KL(r, 1) = "a": KL(r, 2) = "b"
                BO(r, 0) = "x"
            End If
        End If
    Next r
If chk Then
    .Range("BK5").Resize(100000, 2).ClearContents
    .Range("BK5").Resize(z, 2) = KL
    .Range("BO5").Resize(100000, 1).ClearContents
    .Range("BO5").Resize(z, 1) = BO
End If
End With
Application.ScreenUpdating = True
End Sub

 

[Hoàng Nhật Phương]

Sub BKLO()
Application.ScreenUpdating = False
Dim DK As Variant, z As Long, r As Long, KL() As Variant, BO() As Variant
Dim d1 As Long, d2 As Long, D As Variant, tmp As Variant, chk As Boolean
d1 = CLng(Sheet3.Range("H2").Value2): d2 = CLng(Sheet3.Range("J2").Value2)
With Sheet1
    .AutoFilterMode = False
    z = .Range("D" & .Rows.Count).End(xlUp).Row
    DK = .Range("M5:M" & z).Value2: z = UBound(DK, 1)
    ReDim KL(1 To z, 1 To 2): ReDim BO(1 To z, 0)
    For r = 1 To z
        D = DK(r, 1)
          If D <> Empty Then
            D = CLng(D)
            If d1 <= D And D <= d2 Then
                chk = True
                KL(r, 1) = "a": KL(r, 2) = "b"
                BO(r, 0) = "x"
            End If
        End If
    Next r
If chk Then
    .Range("BK5").Resize(100000, 2).ClearContents
    .Range("BK5").Resize(z, 2) = KL
    .Range("BO5").Resize(100000, 1).ClearContents
    .Range("BO5").Resize(z, 1) = BO
End If
End With
Application.ScreenUpdating = True
End Sub

Cảm ơn befaint rất nhiều,
Kết quả rất tuyệt vời, Oanh Thơ không có ý kiến gì thêm

 

[Hoàng Nhật Phương]

Xin chào tất cả các bạn.

Tôi có một trường hợp nêu trong tập tin đính kèm.
Nhờ các bạn xem và giúp cho tôi với ạ.

 

[Ba Tê]

Xin chào tất cả các bạn.

Tôi có một trường hợp nêu trong tập tin đính kèm.
Nhờ các bạn xem và giúp cho tôi với ạ.

K2=Today() thì K2 đâu cần phải "dính" vào code phải không?

Public Sub GPE()
Dim sArr(), I As Long, J As Long, Rws As Long, Col As Long
Dim Ngay As Long, Num As Long, DK As String
    Col = Range("D5").End(xlToRight).Column - 2
    sArr = Range("C6", Range("C6").End(xlDown)).Resize(, Col).Value
    Rws = UBound(sArr): DK = UCase(Range("O4"))
    Ngay = Date
For I = 1 To Rws
    Num = IIf(sArr(I, 1) >= Ngay And UCase(sArr(I, 2)) = DK, 1, 0)
        For J = 3 To Col
            sArr(I, J) = Num
        Next J
Next I
Range("C6").Resize(Rws, Col) = sArr
End Sub

 

[Hoàng Nhật Phương]

K2=Today() thì K2 đâu cần phải "dính" vào code phải không?

Public Sub GPE()
Dim sArr(), I As Long, J As Long, Rws As Long, Col As Long
Dim Ngay As Long, Num As Long, DK As String
    Col = Range("D5").End(xlToRight).Column - 2
    sArr = Range("C6", Range("C6").End(xlDown)).Resize(, Col).Value
    Rws = UBound(sArr): DK = UCase(Range("O4"))
    Ngay = Date
For I = 1 To Rws
    Num = IIf(sArr(I, 1) >= Ngay And UCase(sArr(I, 2)) = DK, 1, 0)
        For J = 3 To Col
            sArr(I, J) = Num
        Next J
Next I
Range("C6").Resize(Rws, Col) = sArr
End Sub

Kết quả đúng ý tôi rồi ,
Cảm ơn Ba Tê nhiều nhiều