Giúp về hàm tìm kiếm trong Excel (1 người xem)

[tranvanutkgvl]

Thân chào diễn đàn GPE
Hiện tại tôi có một vấn đề cần các ace diễn đàn trợ giúp.
Vấn đề là tôi có 1 sheet ds tổng có dữ liệu chung, có các cột Stt, Họ tên, Tổ. Từ đây tôi muốn tạo thêm các Sheet Tổ 1, Tổ 2, Tổ 3, Tổ 4 lấy dữ liệu từ sheet ds tổng theo đúng dữ liệu là số tổ. Chi tiết có trong file đính kèm.
Rất cám ơn ace GPE
Trân trọng

 

[excel_lv1.5]

Thân chào diễn đàn GPE
Hiện tại tôi có một vấn đề cần các ace diễn đàn trợ giúp.
Vấn đề là tôi có 1 sheet ds tổng có dữ liệu chung, có các cột Stt, Họ tên, Tổ. Từ đây tôi muốn tạo thêm các Sheet Tổ 1, Tổ 2, Tổ 3, Tổ 4 lấy dữ liệu từ sheet ds tổng theo đúng dữ liệu là số tổ. Chi tiết có trong file đính kèm.
Rất cám ơn ace GPE
Trân trọng

Bạn sửa tên sheet "ds tổng" thành "dstong" , xóa bỏ các sheet tổ hiện tại rồi chạy code này:

Sub tachto()
Dim i As Long, j As Long, k As Long, m As Long, arr, darr, dic As Object
arr = Sheets("dstong").Range("A3:D" & [B10000].End(xlUp).Row)
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
    If Not dic.exists(CStr(arr(i, 4))) Then
        dic.Add CStr(arr(i, 4)), 1
    Else
        dic.Item(CStr(arr(i, 4))) = dic.Item(CStr(arr(i, 4))) + 1
    End If
Next i
For i = 0 To dic.Count - 1
    ReDim darr(1 To dic.items()(i), 1 To 4)
    Sheets.Add after:=Sheets(Sheets.Count)
    m = 0
    With Sheets(Sheets.Count)
        Sheets("dstong").[a1:d2].Copy .[a1]
        .Name = "To " & dic.keys()(i)
        For j = 1 To UBound(arr)
            If CStr(arr(j, 4)) = dic.keys()(i) Then
                m = m + 1
                For k = 1 To UBound(arr, 2)
                    darr(m, k) = arr(j, k)
                Next k
            End If
        Next j
        .[a3].Resize(UBound(darr), 4) = darr
    End With
Next i
Application.CutCopyMode = False
End Sub