Code VBA lọc theo điều kiện ngày (1 người xem)

hoahuongduong1986 · 6/6/19

Kính gửi Anh Chị,
E muốn gõ hai ngày bất kỳ M2:M3 để lọc dữ liệu sang A:C và E:G từ Sheet Data thì Code thế nào ạ. Em cảm ơn anh chị ạ.

snow25 · 6/6/19

hoahuongduong1986 đã viết:
Kính gửi Anh Chị,
E muốn gõ hai ngày bất kỳ M2:M3 để lọc dữ liệu sang A:C và E:G từ Sheet Data thì Code thế nào ạ. Em cảm ơn anh chị ạ.

Bạn thử.

Mã:

Sub vovan()
    Dim arr, arr1, arr2, i As Long, lr As Long, a1 As Long, a2 As Long, ngay1 As Long, ngay2 As Long
    With Sheets("data")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:I" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 3)
         ReDim arr2(1 To UBound(arr, 1), 1 To 3)
    End With
    With Sheets("loc")
         ngay1 = .Range("m2").Value2
         ngay2 = .Range("m3").Value2
         For i = 1 To UBound(arr)
             If CLng(arr(i, 1)) = ngay1 Then
                a1 = a1 + 1
                arr1(a1, 1) = arr(i, 1)
                arr1(a1, 2) = arr(i, 4)
                arr1(a1, 3) = arr(i, 9)
             End If
             If CLng(arr(i, 1)) = ngay2 Then
                a2 = a2 + 1
                arr2(a2, 1) = arr(i, 1)
                arr2(a2, 2) = arr(i, 4)
                arr2(a2, 3) = arr(i, 9)
             End If
        Next i
        .Range("a2:G10000").ClearContents
        If a1 Then .Range("A2").Resize(a1, 3).Value = arr1
        If a2 Then .Range("E2").Resize(a2, 3).Value = arr2
   End With
End Sub

hoahuongduong1986 · 6/6/19

snow25 đã viết:

Bạn thử.

Mã:

Sub vovan()
    Dim arr, arr1, arr2, i As Long, lr As Long, a1 As Long, a2 As Long, ngay1 As Long, ngay2 As Long
    With Sheets("data")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:I" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 3)
         ReDim arr2(1 To UBound(arr, 1), 1 To 3)
    End With
    With Sheets("loc")
         ngay1 = .Range("m2").Value2
         ngay2 = .Range("m3").Value2
         For i = 1 To UBound(arr)
             If CLng(arr(i, 1)) = ngay1 Then
                a1 = a1 + 1
                arr1(a1, 1) = arr(i, 1)
                arr1(a1, 2) = arr(i, 4)
                arr1(a1, 3) = arr(i, 9)
             End If
             If CLng(arr(i, 1)) = ngay2 Then
                a2 = a2 + 1
                arr2(a2, 1) = arr(i, 1)
                arr2(a2, 2) = arr(i, 4)
                arr2(a2, 3) = arr(i, 9)
             End If
        Next i
        .Range("a2:G10000").ClearContents
        If a1 Then .Range("A2").Resize(a1, 3).Value = arr1
        If a2 Then .Range("E2").Resize(a2, 3).Value = arr2
   End With
End Sub

Quá tuyệt vời ạ. Cảm ơn anh nhiều ạ !!!

hoahuongduong1986 · 7/6/19

snow25 đã viết:

Bạn thử.

Mã:

Sub vovan()
    Dim arr, arr1, arr2, i As Long, lr As Long, a1 As Long, a2 As Long, ngay1 As Long, ngay2 As Long
    With Sheets("data")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:I" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 3)
         ReDim arr2(1 To UBound(arr, 1), 1 To 3)
    End With
    With Sheets("loc")
         ngay1 = .Range("m2").Value2
         ngay2 = .Range("m3").Value2
         For i = 1 To UBound(arr)
             If CLng(arr(i, 1)) = ngay1 Then
                a1 = a1 + 1
                arr1(a1, 1) = arr(i, 1)
                arr1(a1, 2) = arr(i, 4)
                arr1(a1, 3) = arr(i, 9)
             End If
             If CLng(arr(i, 1)) = ngay2 Then
                a2 = a2 + 1
                arr2(a2, 1) = arr(i, 1)
                arr2(a2, 2) = arr(i, 4)
                arr2(a2, 3) = arr(i, 9)
             End If
        Next i
        .Range("a2:G10000").ClearContents
        If a1 Then .Range("A2").Resize(a1, 3).Value = arr1
        If a2 Then .Range("E2").Resize(a2, 3).Value = arr2
   End With
End Sub

Dear Anh,
Nếu em thêm 2 điều kiện lọc nữa là ĐỘ TUỔI và MÃ HÀNG cùng chỉ lấy giá trị là NUL thì thay đổi code thêm thế nào ạ. Em cảm ơn Anh ạ.

snow25 · 8/6/19

hoahuongduong1986 đã viết:
Dear Anh,
Nếu em thêm 2 điều kiện lọc nữa là ĐỘ TUỔI và MÃ HÀNG cùng chỉ lấy giá trị là NUL thì thay đổi code thêm thế nào ạ. Em cảm ơn Anh ạ.

Bạn thử sub này.

Mã:

Sub vovan()
    Dim arr, arr1, arr2, i As Long, lr As Long, a1 As Long, a2 As Long, ngay1 As Long, ngay2 As Long, tuoi As String, mahang As String
    With Sheets("data")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:I" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 3)
         ReDim arr2(1 To UBound(arr, 1), 1 To 3)
    End With
    With Sheets("loc")
         ngay1 = .Range("m2").Value2
         ngay2 = .Range("m3").Value2
         tuoi = .Range("M5").Value
         mahang = .Range("m6").Value
         For i = 1 To UBound(arr)
             If CLng(arr(i, 1)) = ngay1 Then
                If tuoi = arr(i, 6) And mahang = arr(i, 8) Then
                a1 = a1 + 1
                arr1(a1, 1) = arr(i, 1)
                arr1(a1, 2) = arr(i, 4)
                arr1(a1, 3) = arr(i, 9)
                End If
             End If
             If CLng(arr(i, 1)) = ngay2 Then
             If tuoi = arr(i, 6) And mahang = arr(i, 8) Then
                a2 = a2 + 1
                arr2(a2, 1) = arr(i, 1)
                arr2(a2, 2) = arr(i, 4)
                arr2(a2, 3) = arr(i, 9)
             End If
             End If
        Next i
        .Range("a2:G10000").ClearContents
        If a1 Then .Range("A2").Resize(a1, 3).Value = arr1
        If a2 Then .Range("E2").Resize(a2, 3).Value = arr2
   End With
End Sub

leonguyenz · 8/6/19

hoahuongduong1986 đã viết:
Dear Anh,
Nếu em thêm 2 điều kiện lọc nữa là ĐỘ TUỔI và MÃ HÀNG cùng chỉ lấy giá trị là NUL thì thay đổi code thêm thế nào ạ. Em cảm ơn Anh ạ.

Tham khảo thêm AdvancedFilter:

Mã:

Sub Button2_Click()
Dim Rng As Range
Set Rng = Sheet1.Range("A1:I" & Sheet1.Range("A65535").End(xlUp).Row)
With Sheet2
    .Range("P2:V65535").ClearContents
    Rng.AdvancedFilter 2, .Range("L8:N9"), .Range("P1:R1")
    Rng.AdvancedFilter 2, .Range("L11:N12"), .Range("T1:V1")
End With
End Sub

hoahuongduong1986 · 8/6/19

snow25 đã viết:

Bạn thử sub này.

Mã:

Sub vovan()
    Dim arr, arr1, arr2, i As Long, lr As Long, a1 As Long, a2 As Long, ngay1 As Long, ngay2 As Long, tuoi As String, mahang As String
    With Sheets("data")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:I" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 3)
         ReDim arr2(1 To UBound(arr, 1), 1 To 3)
    End With
    With Sheets("loc")
         ngay1 = .Range("m2").Value2
         ngay2 = .Range("m3").Value2
         tuoi = .Range("M5").Value
         mahang = .Range("m6").Value
         For i = 1 To UBound(arr)
             If CLng(arr(i, 1)) = ngay1 Then
                If tuoi = arr(i, 6) And mahang = arr(i, 8) Then
                a1 = a1 + 1
                arr1(a1, 1) = arr(i, 1)
                arr1(a1, 2) = arr(i, 4)
                arr1(a1, 3) = arr(i, 9)
                End If
             End If
             If CLng(arr(i, 1)) = ngay2 Then
             If tuoi = arr(i, 6) And mahang = arr(i, 8) Then
                a2 = a2 + 1
                arr2(a2, 1) = arr(i, 1)
                arr2(a2, 2) = arr(i, 4)
                arr2(a2, 3) = arr(i, 9)
             End If
             End If
        Next i
        .Range("a2:G10000").ClearContents
        If a1 Then .Range("A2").Resize(a1, 3).Value = arr1
        If a2 Then .Range("E2").Resize(a2, 3).Value = arr2
   End With
End Sub

Em cảm ơn sự nhiệt tình giúp đỡ của anh ạ !!!

Bài đã được tự động gộp: 8/6/19

leonguyenz đã viết:

Tham khảo thêm AdvancedFilter:

Mã:

Sub Button2_Click()
Dim Rng As Range
Set Rng = Sheet1.Range("A1:I" & Sheet1.Range("A65535").End(xlUp).Row)
With Sheet2
    .Range("P2:V65535").ClearContents
    Rng.AdvancedFilter 2, .Range("L8:N9"), .Range("P1:R1")
    Rng.AdvancedFilter 2, .Range("L11:N12"), .Range("T1:V1")
End With
End Sub

Em cảm ơn sự giúp đỡ nhiệt tình của Anh ạ !

hoahuongduong1986 · 15/6/19

leonguyenz đã viết:

Tham khảo thêm AdvancedFilter:

Mã:

Sub Button2_Click()
Dim Rng As Range
Set Rng = Sheet1.Range("A1:I" & Sheet1.Range("A65535").End(xlUp).Row)
With Sheet2
    .Range("P2:V65535").ClearContents
    Rng.AdvancedFilter 2, .Range("L8:N9"), .Range("P1:R1")
    Rng.AdvancedFilter 2, .Range("L11:N12"), .Range("T1:V1")
End With
End Sub

Dear Anh
Anh cho em hỏi thêm chút ạ.
(1) Nếu dùng code của anh: Chẳng hạn em bổ sung điều kiện lọc học vấn. Biểu điễn thế nào để em có thể lọc được đồng thời hai điều kiện ạ. Chẳng hạn em cùng chọn CD và DH ạ. và em muốn hỏi thêm Rng.AdvancedFilter 2 - thì số 2 có nghĩa là gì ạ.
(2) Nếu dùng Code dictionary thì chẳng hạn M5 (Độ tuổi) Em muốn lấy toàn bộ các tuổi là số và rỗng, không lấy NULL thì sửa code hoặc điều kiện biểu diễn tại M5 thế nào ạ.

leonguyenz · 15/6/19

hoahuongduong1986 đã viết:
Dear Anh
Anh cho em hỏi thêm chút ạ. Chẳng hạn em bổ sung điều kiện lọc học vấn. Biểu điễn thế nào để em có thể lọc được đồng thời hai điều kiện ạ. Chẳng hạn em cùng chọn CD và DH ạ. và em muốn hỏi thêm Rng.AdvancedFilter 2 - thì số 2 có nghĩa là gì ạ. Em cảm ơn anh ạ.

Bạn dùng AdvancedFilter bình thường hoặc ghi marco sẽ rõ. Số 1 là lọc trên vùng dữ liệu, số 2 là lọc và copy sang chỗ khác.
Tôi đang dùng điện thoại nên không ví dụ được.

hoahuongduong1986 · 15/6/19

leonguyenz đã viết:
Bạn dùng AdvancedFilter bình thường hoặc ghi marco sẽ rõ. Số 1 là lọc trên vùng dữ liệu, số 2 là lọc và copy sang chỗ khác.
Tôi đang dùng điện thoại nên không ví dụ được.

Dạ em có thêm các điều kiện tại ô lọc như Or(CD, DH), <>"", <> NULL, >1...nhưng em thấy nó không lọc được ạ.

Code VBA lọc theo điều kiện ngày (1 người xem)

Người dùng đang xem chủ đề này

hoahuongduong1986

Thành viên thường trực

File đính kèm

snow25

Thành viên gạo cội

File đính kèm

hoahuongduong1986

Thành viên thường trực

hoahuongduong1986

Thành viên thường trực

File đính kèm

snow25

Thành viên gạo cội

leonguyenz

Thành viên gạo cội

File đính kèm

hoahuongduong1986

Thành viên thường trực

hoahuongduong1986

Thành viên thường trực

File đính kèm

leonguyenz

Thành viên gạo cội

hoahuongduong1986

Thành viên thường trực

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Sinh nhật lần 19 GPE