Tách sheel tổng hợp thành nhiều sheel theo nhiều điều kiện bằng VBA

chidung2009 · 8/9/20

Mình có 1 sheet tổng hợp giờ muốn tách thành nhiều sheel con theo hai điều kiện như sau:
- Tại ô G3 chọn tên huyện Đăk Hà ( hoặc bất kỳ) thì từ Sheet tổng hợp sẽ tách ra các sheel con chỉ liệt kê nhận viên đó thuộc huyện Đăk Hà , còn chức vụ thì Chánh án liệt kê vào Sheet ChanhAn, Thẩm phán vào Sheet ThamPhan, Nhân viên vào sheet NhanVien ....
- Nếu tại ô điều kiện G3 để trống thì liệt kê tất cả số nhân viên ở sheet TongHop vào các sheel con theo từng chức vụ tương ứng với từng sheet như trên
Mình xin cảm ơn

be_09 · 8/9/20

chidung2009 đã viết:
Mình có 1 sheet tổng hợp giờ muốn tách thành nhiều sheel con theo hai điều kiện như sau:
- Tại ô G3 chọn tên huyện Đăk Hà ( hoặc bất kỳ) thì từ Sheet tổng hợp sẽ tách ra các sheel con chỉ liệt kê nhận viên đó thuộc huyện Đăk Hà , còn chức vụ thì Chánh án liệt kê vào Sheet ChanhAn, Thẩm phán vào Sheet ThamPhan, Nhân viên vào sheet NhanVien ....
- Nếu tại ô điều kiện G3 để trống thì liệt kê tất cả số nhân viên ở sheet TongHop vào các sheel con theo từng chức vụ tương ứng với từng sheet như trên
Mình xin cảm ơn

Dùng thử File.
Copy dữ liệu vào sheet TongHop rồi nhấn nút để xem kết quả.
Tôi có công giúp nhớ xử tôi nhẹ tay nhé.

CHAOQUAY · 8/9/20

chidung2009 đã viết:
Mình có 1 sheet tổng hợp giờ muốn tách thành nhiều sheel con theo hai điều kiện như sau:
- Tại ô G3 chọn tên huyện Đăk Hà ( hoặc bất kỳ) thì từ Sheet tổng hợp sẽ tách ra các sheel con chỉ liệt kê nhận viên đó thuộc huyện Đăk Hà , còn chức vụ thì Chánh án liệt kê vào Sheet ChanhAn, Thẩm phán vào Sheet ThamPhan, Nhân viên vào sheet NhanVien ....
- Nếu tại ô điều kiện G3 để trống thì liệt kê tất cả số nhân viên ở sheet TongHop vào các sheel con theo từng chức vụ tương ứng với từng sheet như trên
Mình xin cảm ơn

Tham khảo thêm 1 cách
Tạm thời danh sách cán bộ theo huyện ghi vào sheet tonghop cột G

Mã:

Option Explicit
Dim dicTt As Object

Sub loc()
Dim nguon
Dim huyen
Dim ds, cv, tam
Dim rws, i, j, k, x, z
With Sheet1
    nguon = .Range("A4", "E" & .Range("D4").End(xlDown).Row)
    huyen = .Range("G3")
    rws = UBound(nguon)
End With

If dicTt Is Nothing Then
    Set dicTt = CreateObject("Scripting.Dictionary")
    For i = 1 To rws
        z = Left(nguon(i, 4), 1)
        If dicTt.Exists(nguon(i, 3)) = False Then
            ReDim tam(1 To rws, 1 To 5)
            ReDim ds(1 To rws, 1 To 1)
            ds(1, 1) = nguon(i, 2)
            ReDim cv(1 To rws, 1 To 5)
            For j = 1 To 5
                cv(1, j) = nguon(i, j)
            Next j
            'ten; chanhan; thamphan; nhanvie; ketoan
            If z = "C" Then dicTt(nguon(i, 3)) = Array(Array(1, ds), Array(1, cv), Array(0, tam), Array(0, tam), Array(0, tam))
            If z = "T" Then dicTt(nguon(i, 3)) = Array(Array(1, ds), Array(0, tam), Array(1, cv), Array(0, tam), Array(0, tam))
            If z = "N" Then dicTt(nguon(i, 3)) = Array(Array(1, ds), Array(0, tam), Array(0, tam), Array(1, cv), Array(0, tam))
            If z = "K" Then dicTt(nguon(i, 3)) = Array(Array(1, ds), Array(0, tam), Array(0, tam), Array(0, tam), Array(1, cv))
        Else
            tam = dicTt(nguon(i, 3))
            ds = tam(0)(1)
            k = tam(0)(0)
            k = k + 1
            ds(k, 1) = nguon(i, 2)
            tam(0) = Array(k, ds)
           
            If z = "C" Then k = 1
            If z = "T" Then k = 2
            If z = "N" Then k = 3
            If z = "K" Then k = 4
            cv = tam(k)(1)
            x = tam(k)(0) + 1
            For j = 1 To 5
                cv(x, j) = nguon(i, j)
            Next j
            tam(k) = Array(x, cv)
            dicTt(nguon(i, 3)) = tam
        End If
    Next i
End If

For Each k In Worksheets
    If k.Name <> "TongHop" Then k.Range("A4").Resize(rws, 5).ClearContents
Next k
Sheet1.Range("G5", "G" & rws + 5).ClearContents

If huyen = "" Then
    For Each tam In dicTt.Items
        k = tam(1)(0)
        ds = tam(1)(1)
        If k > 0 Then Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
        k = tam(2)(0)
        ds = tam(2)(1)
        If k > 0 Then Sheet3.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
        k = tam(3)(0)
        ds = tam(3)(1)
        If k > 0 Then Sheet4.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
        k = tam(4)(0)
        ds = tam(4)(1)
        If k > 0 Then Sheet5.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
    Next tam
Else
    tam = dicTt(huyen)
    Sheet1.Range("G5").Resize(tam(0)(0), 1) = tam(0)(1)
    k = tam(1)(0)
    ds = tam(1)(1)
    If k > 0 Then Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
    k = tam(2)(0)
    ds = tam(2)(1)
    If k > 0 Then Sheet3.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
    k = tam(3)(0)
    ds = tam(3)(1)
    If k > 0 Then Sheet4.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
    k = tam(4)(0)
    ds = tam(4)(1)
    If k > 0 Then Sheet5.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
End If
End Sub

chidung2009 · 8/9/20

be09 đã viết:
Dùng thử File.
Copy dữ liệu vào sheet TongHop rồi nhấn nút để xem kết quả.
Tôi có công giúp nhớ xử tôi nhẹ tay nhé.

gần được như ý mình rồi. cảm ơn anh be09 nhiều nha

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

CHAOQUAY đã viết:

Tham khảo thêm 1 cách
Tạm thời danh sách cán bộ theo huyện ghi vào sheet tonghop cột G

Mã:

Option Explicit
Dim dicTt As Object

Sub loc()
Dim nguon
Dim huyen
Dim ds, cv, tam
Dim rws, i, j, k, x, z
With Sheet1
    nguon = .Range("A4", "E" & .Range("D4").End(xlDown).Row)
    huyen = .Range("G3")
    rws = UBound(nguon)
End With

If dicTt Is Nothing Then
    Set dicTt = CreateObject("Scripting.Dictionary")
    For i = 1 To rws
        z = Left(nguon(i, 4), 1)
        If dicTt.Exists(nguon(i, 3)) = False Then
            ReDim tam(1 To rws, 1 To 5)
            ReDim ds(1 To rws, 1 To 1)
            ds(1, 1) = nguon(i, 2)
            ReDim cv(1 To rws, 1 To 5)
            For j = 1 To 5
                cv(1, j) = nguon(i, j)
            Next j
            'ten; chanhan; thamphan; nhanvie; ketoan
            If z = "C" Then dicTt(nguon(i, 3)) = Array(Array(1, ds), Array(1, cv), Array(0, tam), Array(0, tam), Array(0, tam))
            If z = "T" Then dicTt(nguon(i, 3)) = Array(Array(1, ds), Array(0, tam), Array(1, cv), Array(0, tam), Array(0, tam))
            If z = "N" Then dicTt(nguon(i, 3)) = Array(Array(1, ds), Array(0, tam), Array(0, tam), Array(1, cv), Array(0, tam))
            If z = "K" Then dicTt(nguon(i, 3)) = Array(Array(1, ds), Array(0, tam), Array(0, tam), Array(0, tam), Array(1, cv))
        Else
            tam = dicTt(nguon(i, 3))
            ds = tam(0)(1)
            k = tam(0)(0)
            k = k + 1
            ds(k, 1) = nguon(i, 2)
            tam(0) = Array(k, ds)
         
            If z = "C" Then k = 1
            If z = "T" Then k = 2
            If z = "N" Then k = 3
            If z = "K" Then k = 4
            cv = tam(k)(1)
            x = tam(k)(0) + 1
            For j = 1 To 5
                cv(x, j) = nguon(i, j)
            Next j
            tam(k) = Array(x, cv)
            dicTt(nguon(i, 3)) = tam
        End If
    Next i
End If

For Each k In Worksheets
    If k.Name <> "TongHop" Then k.Range("A4").Resize(rws, 5).ClearContents
Next k
Sheet1.Range("G5", "G" & rws + 5).ClearContents

If huyen = "" Then
    For Each tam In dicTt.Items
        k = tam(1)(0)
        ds = tam(1)(1)
        If k > 0 Then Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
        k = tam(2)(0)
        ds = tam(2)(1)
        If k > 0 Then Sheet3.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
        k = tam(3)(0)
        ds = tam(3)(1)
        If k > 0 Then Sheet4.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
        k = tam(4)(0)
        ds = tam(4)(1)
        If k > 0 Then Sheet5.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
    Next tam
Else
    tam = dicTt(huyen)
    Sheet1.Range("G5").Resize(tam(0)(0), 1) = tam(0)(1)
    k = tam(1)(0)
    ds = tam(1)(1)
    If k > 0 Then Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
    k = tam(2)(0)
    ds = tam(2)(1)
    If k > 0 Then Sheet3.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
    k = tam(3)(0)
    ds = tam(3)(1)
    If k > 0 Then Sheet4.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
    k = tam(4)(0)
    ds = tam(4)(1)
    If k > 0 Then Sheet5.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5) = ds
End If
End Sub

cảm ơn bạn nha, code này chạy rất đúng với ý của mình

Tách sheel tổng hợp thành nhiều sheel theo nhiều điều kiện bằng VBA

chidung2009

Thành viên hoạt động

File đính kèm

be_09

Biên Hòa, Đồng Nai

File đính kèm

CHAOQUAY

Thành viên gắn bó

chidung2009

Thành viên hoạt động

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