tự động Tách thành hai danh sách theo điều kiện

[chidung2009]

Mình có một file excel có dữ liệu từ cột A7:C50.
nhập dữ liệu vào cột B và khi chọn Thẩm phán hoặc Thư ký theo List thì sẽ tự động cập nhật tạo thành 2 danh sách theo bảng thẩm phán (R7 : T) và thư ký (U7: W ) có số thứ tự tự động tăng theo từ danh sách.
Mình chân thành cảm ơn

 

[vanaccex]

Mình có một file excel có dữ liệu từ cột A7:C50.
nhập dữ liệu vào cột B và khi chọn Thẩm phán hoặc Thư ký theo List thì sẽ tự động cập nhật tạo thành 2 danh sách theo bảng thẩm phán (R7 : T) và thư ký (U7: W ) có số thứ tự tự động tăng theo từ danh sách.
Mình chân thành cảm ơn

Bạn thử đoạn code sau xem

Sub PhanTich()
Dim i As Long, aDuLieu(), KetQua(), k As Long, Jk As Long
Dim Dieukien As Variant
With sHome
   aDuLieu = .Range("B8:C" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value
End With
    ReDim KetQua(1 To UBound(aDuLieu, 1), 1 To 6)
  For i = 1 To UBound(aDuLieu, 1)
    Dieukien = "Th" & ChrW(7849) & "m ph" & ChrW(225) & "n"
    If aDuLieu(i, 2) Like Dieukien Then
        k = k + 1
        KetQua(k, 1) = k
        KetQua(k, 2) = aDuLieu(i, 1)
        KetQua(k, 3) = aDuLieu(i, 2)
    Else
        Jk = Jk + 1
        KetQua(Jk, 4) = Jk
        KetQua(Jk, 5) = aDuLieu(i, 1)
        KetQua(Jk, 6) = aDuLieu(i, 2)
    End If
   Next
With sHome
    .Range("R9:W10000").ClearContents
If k <> 0 Or Jk <> 0 Then
    .Range("R9").Resize(UBound(KetQua), 6).Value = KetQua
End If
End With
End Sub

 

[chidung2009]

Bạn thử đoạn code sau xem

Sub PhanTich()
Dim i As Long, aDuLieu(), KetQua(), k As Long, Jk As Long
Dim Dieukien As Variant
With sHome
   aDuLieu = .Range("B8:C" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value
End With
    ReDim KetQua(1 To UBound(aDuLieu, 1), 1 To 6)
  For i = 1 To UBound(aDuLieu, 1)
    Dieukien = "Th" & ChrW(7849) & "m ph" & ChrW(225) & "n"
    If aDuLieu(i, 2) Like Dieukien Then
        k = k + 1
        KetQua(k, 1) = k
        KetQua(k, 2) = aDuLieu(i, 1)
        KetQua(k, 3) = aDuLieu(i, 2)
    Else
        Jk = Jk + 1
        KetQua(Jk, 4) = Jk
        KetQua(Jk, 5) = aDuLieu(i, 1)
        KetQua(Jk, 6) = aDuLieu(i, 2)
    End If
   Next
With sHome
    .Range("R9:W10000").ClearContents
If k <> 0 Or Jk <> 0 Then
    .Range("R9").Resize(UBound(KetQua), 6).Value = KetQua
End If
End With
End Sub

Gần đúng ý của mình rồi. Cảm ơn bạn đã giúp đỡ

 

[be_09]

Mình có một file excel có dữ liệu từ cột A7:C50.
nhập dữ liệu vào cột B và khi chọn Thẩm phán hoặc Thư ký theo List thì sẽ tự động cập nhật tạo thành 2 danh sách theo bảng thẩm phán (R7 : T) và thư ký (U7: W ) có số thứ tự tự động tăng theo từ danh sách.
Mình chân thành cảm ơn

Thử sử dụng Filter từ Sheet Theo dõi rồi Copy qua từng sheet để thuận tiện cho việc in danh sách..

 

[SA_DQ]

Cách khác nữa nè, bạn thử tham khảo cho vui!

 

[VetMini]

Thử sử dụng Filter từ Sheet Theo dõi rồi Copy qua từng sheet để thuận tiện cho việc in danh sách..

Giải pháp của bạn không có "tự động"

 

[chidung2009]

Giải pháp của bạn không có "tự động"

View attachment 230720

Cảm ơn bạn nhiều

 

[be_09]

Giải pháp của bạn không có "tự động"

View attachment 230720

Muốn tự động thì thêm code sau vào sheet Theo dõi.

Private Sub Worksheet_Change(ByVal Target As Range)
    Call Filter_Copy
End Sub

Do mỗi lần thay đổi nội dung thì gây nhấp nháy màn hình nên phải thêm 2 dòng code sau vào đầu và cuối của Module.

Sub Filter_Copy()
    Application.ScreenUpdating = False

    ' Code cũ'

    Application.ScreenUpdating = True
End Sub