Lọc theo điều kiện? (1 người xem)

[KUMI]

Xin chào Thầy Cô cùng các Anh Chị trong GPE!
Em đang vướng mắc một câu hỏi.

Cụ thể câu hỏi và kết quả minh họa em đã nêu trong file kèm.
Thầy Cô cùng Anh Chị xem file và giúp em với ạ.
Em xin cảm ơn.
----
Bài này trước đây em đã hỏi bằng công thức rồi nhưng giờ em muốn chuyển sang vba ạ.

 

[Cá ngừ F1]

Bạn dùng advance filter thử xem, ghi record marco lại. Thế là chuyển sang vba đúng ý bạn (sori, online bằng đt nên ko viết đc vba, chắc sẽ có tv giúp bạn)

 

[nghiaphuc]

Xin chào Thầy Cô cùng các Anh Chị trong GPE!
Em đang vướng mắc một câu hỏi.

Cụ thể câu hỏi và kết quả minh họa em đã nêu trong file kèm.
Thầy Cô cùng Anh Chị xem file và giúp em với ạ.
Em xin cảm ơn.
----
Bài này trước đây em đã hỏi bằng công thức rồi nhưng giờ em muốn chuyển sang vba ạ.

Bạn dùng code này xem:
[GPECODE=vb]Sub LocDL()
Dim Tmp, Arr(), i As Long, j As Long, k As Long, l As Long
Tmp = Sheets("Sheet1").[E8:F1000]
ReDim Arr(1 To UBound(Tmp), 1 To 3)
For i = 1 To UBound(Tmp)
If IsEmpty(Tmp(i, 1)) Then Exit For
If Tmp(i, 2) = "T1" Then
j = j + 1: Arr(j, 1) = Tmp(i, 1)
ElseIf Tmp(i, 2) = "T2" Then
k = k + 1: Arr(k, 2) = Tmp(i, 1)
ElseIf Tmp(i, 2) = "T3" Then
l = l + 1: Arr(l, 3) = Tmp(i, 1)
End If
Next
k = WorksheetFunction.Max(j, k, l)
With Sheets("Sheet1")
.[H8:J1000].Clear
If k > 0 Then .[H8:J8].Resize(k, 3).Value = Arr
.[H8:J8].Resize(k, 3).Borders.LineStyle = 1
End With
End Sub[/GPECODE]

 

[Ba Tê]

Xin chào Thầy Cô cùng các Anh Chị trong GPE!
Em đang vướng mắc một câu hỏi.

Cụ thể câu hỏi và kết quả minh họa em đã nêu trong file kèm.
Thầy Cô cùng Anh Chị xem file và giúp em với ạ.
Em xin cảm ơn.
----
Bài này trước đây em đã hỏi bằng công thức rồi nhưng giờ em muốn chuyển sang vba ạ.

Thử xem file này, bi nhiêu Tổ cũng được.

 

[KUMI]

Thử xem file này, bi nhiêu Tổ cũng được.

Oh,Tuyệt quá!
Hihi,Cảm ơn ơn GPE!
Em cảm ơn Thầy Ba Tê & Anh Nghĩa Phúc nhiều lắm.
Cả 2 bài viết đều đúng theo theo ý em cả. (^_-)!

 

[KUMI]

Thử xem file này, bi nhiêu Tổ cũng được.

Thầy ơi, Phiền giúp giúp em lấy dữ liệu so le tại các cột vởi ạ.
Nghĩa là em chỉ lấy dữ liệu vào cột màu xanh bảng bên.
Còn ô màu vàng để trống.

 

[Ba Tê]

Thầy ơi, Phiền giúp giúp em lấy dữ liệu so le tại các cột vởi ạ.
Nghĩa là em chỉ lấy dữ liệu vào cột màu xanh bảng bên.
Còn ô màu vàng để trống.

Sao lại thay đổi yêu cầu vậy?
Không làm cái dòng tiêu đề nghe. Muốn bi nhiêu cột thì tự làm bi nhiêu tiêu đề cột.
Code này chỉ sử dụng tối đa 50 tổ thôi đó.
[GPECODE=vb]
Public Sub GPE_()
Dim Dic As Object, sArr(), dArr(), tArr(), I As Long, K As Long, C As Long, N As Long, MaxRow As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([E8], [E8].End(xlDown)).Resize(, 2).Value2
ReDim tArr(1 To UBound(sArr, 1), 1 To 1)
C = -1
For I = 1 To UBound(sArr, 1)
Tem = sArr(I, 2)
If Not Dic.Exists(Tem) Then
C = C + 2
Dic.Add Tem, C
tArr(C, 1) = Tem
End If
Next I
ReDim dArr(1 To UBound(sArr, 1), 1 To C)
For N = 1 To UBound(tArr, 1)
K=0
For I = 1 To UBound(sArr, 1)
Tem = sArr(I, 2)
If Tem = tArr(N, 1) Then
K = K + 1
dArr(K, Dic.Item(Tem)) = sArr(I, 1)
If K > MaxRow Then MaxRow = K
End If
Next I
Next N
[H8].Resize(1000, 100).ClearContents
[H8].Resize(MaxRow, C) = dArr
Set Dic = Nothing
End Sub[/GPECODE]

 

[KUMI]

Sao lại thay đổi yêu cầu vậy?
Không làm cái dòng tiêu đề nghe. Muốn bi nhiêu cột thì tự làm bi nhiêu tiêu đề cột.
Code này chỉ sử dụng tối đa 50 tổ thôi đó.

Em cảm ơn Thầy đã giúp đỡ ạ.Em test kết quả kết quả thấy đúng rồi ạ.
Sở dĩ em muốn thêm 1 cột sole để làm một cột mã số nhân viên ạ cái này cũng mới có ý tưởng thôi ạ.