Code VBA tìm kiếm theo ngày (1 người xem)

[GTK-PM]

Em vội quá, sr bác.
Nội dung như sau: Tại sheet BaoChi có điều kiện cần tìm kiếm tại ô S7 đến T7, lọc từ sheet QuyTM lấy dữ liệu tại cột E9:E5000 thỏa điều kiện S7 đến T7 thì trả về các ô " Ngày tháng. Nội dung. Số tiền, Ghi chú " ( Như cách em đang làm thủ công )
Trong sheet báo chi cho em tự động co dãn hàng từ hàng 12 đến hàng 500 ( VD: dữ liệu có từ hàng 12 đến 50 thì sẽ tự động Hide từ 51 đến 500 )
@Bate
Link: http://upfile.vn/_VBCN~jCNrIg/00-soquytm-xls.html

 

[Ba Tê]

Gửi anh chị, em muốn nhờ anh chị giúp đỡ tại sheet BaoChi dò tìm theo điều kiện ô S7 và T7
Và trả kết quả về như ô em đã bôi vàng trong file.
Trong sheet báo chi cho em tự động co dãn hàng từ hàng 12 đến hàng 500 ( VD: dữ liệu có từ hàng 12 đến 50 thì sẽ tự động Hide từ 51 đến 500 )
Link: http://upfile.vn/_VBCN~jCNrIg/00-soquytm-xls.html

"Người ngoại đạo", Hiểu chết liền.
Điều kiện S7 và T7 là sao? Lấy cột nào? Vừa =S7 và = T7 ?
S7= 3/3/2017; T7 = 7/3/2017 mà bảng kết quả mẫu vùng vàng thì từ ngày 28/2/2017 đến 2/3/2017 có "ăn nhập" gì với 2 ô S7 và T7?
"Hết biết"!

 

[GTK-PM]

Em vội quá, sr bác.
Nội dung như sau: Tại sheet BaoChi có điều kiện cần tìm kiếm tại ô S7 đến T7, lọc từ sheet QuyTM lấy dữ liệu tại cột E9:E5000 thỏa điều kiện S7 đến T7 thì trả về các ô " Ngày tháng. Nội dung. Số tiền, Ghi chú " ( Như cách em đang làm thủ công )
Trong sheet báo chi cho em tự động co dãn hàng từ hàng 12 đến hàng 500 ( VD: dữ liệu có từ hàng 12 đến 50 thì sẽ tự động Hide từ 51 đến 500 )
@Bate

 

[Ba Tê]

Em vội quá, sr bác.
Nội dung như sau: Tại sheet BaoChi có điều kiện cần tìm kiếm tại ô S7 đến T7, lọc từ sheet QuyTM lấy dữ liệu tại cột E9:E5000 thỏa điều kiện S7 đến T7 thì trả về các ô " Ngày tháng. Nội dung. Số tiền, Ghi chú " ( Như cách em đang làm thủ công )
Trong sheet báo chi cho em tự động co dãn hàng từ hàng 12 đến hàng 500 ( VD: dữ liệu có từ hàng 12 đến 50 thì sẽ tự động Hide từ 51 đến 500 )
@Bate

sr là cái gì vậy? Tiếng Việt viết tắt còn đọc không nỗi, hổng biết tiếng gì sao hiểu được.
Trên GPE này nhiều người "cổ hủ" (trong đó có tôi) không hứng thú với mấy kiểu viết như vậy và thường không tham gia trả lời dù là "dễ ẹc".
-----------------------
Bạn tự chèn sao cho Tổng cộng nằm ở dòng 501 trước khi chạy code.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, fDate As Long, eDate As Long
With Sheets("QuyTM")
    sArr = .Range("B9", .Range("B9").End(xlDown)).Resize(, 11).Value
    R = UBound(sArr)
    ReDim dArr(1 To R, 1 To 9)
End With
With Sheets("BaoChi")
    fDate = .Range("S7").Value: eDate = .Range("T7").Value
    For I = 1 To R
        If sArr(I, 3) <> Empty Then
            If sArr(I, 4) >= fDate Then
                If sArr(I, 4) <= eDate Then
                    K = K + 1:  dArr(K, 1) = K
                    dArr(K, 2) = sArr(I, 4): dArr(K, 3) = sArr(I, 8)
                    dArr(K, 7) = sArr(I, 11): dArr(K, 9) = "PC" & sArr(I, 3)
                End If
            End If
        End If
    Next I
    .Rows("12:500").Hidden = False
    .Range("B12:J500").ClearContents
    If K Then .Range("B12").Resize(K, 9) = dArr
    .Rows(K + 12 & ":500").Hidden = True
End With
End Sub

 

[ChanhTQ@]

Bạn tham khảo thêm 1 cách nữa:

Option Explicit
Const MyErr As Double = 1 + vbObjectError + 512
Sub LocCacNgay()
 Dim Sh As Worksheet, sRng As Range, Rng As Range
 Dim SoNgay As Integer, J As Integer, Rws As Long, Dat As Date, W As Integer
 Dim MyAdd As String, MyFormat As String
 On Error GoTo LoiCT
 Set Sh = ThisWorkbook.Worksheets("QuyTM")
 With Sh.[b9]
    Rws = .CurrentRegion.Rows.Count - 3
    Set Rng = .Offset(-1).Resize(Rws)
    MyFormat = Rng.NumberFormat
    Rng.NumberFormat = "MM/DD/yyyy"
 End With
 Dat = [s7].Value
 SoNgay = [t7].Value - [s7].Value + 1
 ReDim Arr(1 To 55, 1 To 5)
 For J = 0 To SoNgay
    Set sRng = Rng.Find(Format(Dat + J, "MM/dd/yyyy"), , xlValues, xlWhole)
    If sRng Is Nothing Then
        Err.Raise Number:=MyErr
    Else
        MyAdd = sRng.Address
        Do
            W = W + 1:                  Arr(W, 1) = W
            Arr(W, 2) = sRng.Value:     Arr(W, 3) = sRng.Offset(, 7).Value
            Arr(W, 5) = sRng.Offset(, 1).Value & sRng.Offset(, 2).Value
            Arr(W, 4) = sRng.Offset(, 9).Value & sRng.Offset(, 10).Value
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next J
 [b12].Resize(W, 5).Value = Arr()
Err_:
    Rng.NumberFormat = MyFormat:        Exit Sub
LoiCT:
    If Err = MyErr Then
'        MsgBox Format(Dat + J, "dd/mm/yy") & ": Không có"  '
        Resume Next
    Else
        [b12].Resize(W, 5).Value = Arr()
        MsgBox Err:                     Resume Err_
    End If
End Sub

 

[GTK-PM]

Em chèn vào cứ thấy bị báo lỗi anh Bate ạ ! Nhờ anh chèn giúp em ạ.

 

[Ba Tê]

Em chèn vào cứ thấy bị báo lỗi anh Bate ạ ! Nhờ anh chèn giúp em ạ.

File này đây, bạn kiểm tra lại xem có lỗi không.

 

[GTK-PM]

Em cám ơn Chanh TQ@ và anh Bate.