Lọc danh sách theo điều kiện bằng VBA.

Liên hệ QC

Congky74

Thành viên mới
Tham gia
25/10/18
Bài viết
43
Được thích
5
Kính gửi Các Anh Chị trên Diễn Đàn.!
Em đang có dữ liệu ở sheet Data. em muốn lấy 40 người trẻ tuổi từ nhỏ đến lớn (dựa vào cột ngày sinh) và là người khuyết tật (ở cột F "loại đối tượng": tìm kếm ô có ký hiệu NKT là người khuyết tật ) . và chép sang sheet Danh sách.
em có làm mẫu ở file. Rất mong các anh chị viết giúp em. Em chân thành cảm ơn.
 

File đính kèm

  • Book1.xlsx
    21.5 KB · Đọc: 11
Kính gửi Các Anh Chị trên Diễn Đàn.!
Em đang có dữ liệu ở sheet Data. em muốn lấy 40 người trẻ tuổi từ nhỏ đến lớn (dựa vào cột ngày sinh) và là người khuyết tật (ở cột F "loại đối tượng": tìm kếm ô có ký hiệu NKT là người khuyết tật ) . và chép sang sheet Danh sách.
em có làm mẫu ở file. Rất mong các anh chị viết giúp em. Em chân thành cảm ơn.
Cột C sheet Data là Text, lúc thì "15/05/2002", lúc thì "1934".
Làm thủ công thì tạo cột phụ, lấy năm của cột C, Sort từ nhỏ đến lớn, lấy bao nhiêu dòng thì tùy.
VBA cũng phải làm vậy thôi.
 
Upvote 0
Kính gửi Các Anh Chị trên Diễn Đàn.!
Em đang có dữ liệu ở sheet Data. em muốn lấy 40 người trẻ tuổi từ nhỏ đến lớn (dựa vào cột ngày sinh) và là người khuyết tật (ở cột F "loại đối tượng": tìm kếm ô có ký hiệu NKT là người khuyết tật ) . và chép sang sheet Danh sách.
em có làm mẫu ở file. Rất mong các anh chị viết giúp em. Em chân thành cảm ơn.
Thử code.Thêm điều kiện vào ô M2 nhé.Chưa có .NET Framework. thì cài thêm nhé.
Mã:
Sub laydulieu()
    Dim i As Long, lr As Long, s As String, arr, a As Long, olit As Object, b As Long, T, dk As String, k As Long, j As Integer
    Set olit = CreateObject("System.Collections.SortedList")
    With Sheets("Data")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 5 Then Exit Sub
         arr = .Range("B5:I" & lr).Value
         a = .Range("L2").Value
         s = .Range("m2").Value
    End With
         For i = 1 To UBound(arr)
             If InStr(arr(i, 5), s) Then
                b = chuyenngay(arr(i, 2))
                If Not olit.Contains(b) Then
                   olit.Add b, i
                Else
                    olit.Item(b) = olit.Item(b) & "#" & i
                End If
             End If
         Next i
         ReDim kq(1 To a, 1 To 8)
         For i = olit.Count - 1 To 0 Step -1
             s = olit.GetByIndex(i)
             For Each T In Split(s, "#")
                 k = k + 1
                 kq(k, 1) = k
                 For j = 2 To 8
                     kq(k, j) = arr(T, j - 1)
                 Next j
                 If k = a Then GoTo thoat
             Next
         Next i
thoat:
    With Sheets("danhsach")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr > 4 Then .Range("A5:H" & lr).ClearContents
         .Range("A5:H5").Resize(a).Value = kq
    End With
End Sub
Function chuyenngay(ByVal dk As String) As Long
        Dim s As String
        If Len(dk) = 10 Then
           chuyenngay = CLng(CDate(dk))
        Else
           chuyenngay = DateSerial(dk, 1, 1)
        End If
End Function
 

File đính kèm

  • Book1.xlsm
    32.3 KB · Đọc: 18
Upvote 0
Web KT

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

Back
Top Bottom