cả nhà giúp em lọc dư liệu theo tên người thực hiện hợp đồng giúp em với ạ (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

tuongktt

Thành viên mới
Tham gia
19/4/20
Bài viết
36
Được thích
4
cả nhà giúp em với ạ, em muốn lọc dư liêu theo tên người thực hiện hợp đồng thành sheet riêng: tùng, miền, huỳnh, sơn ạ
1587692590455.png
 

File đính kèm

  • 1587692480993.png
    1587692480993.png
    67 KB · Đọc: 2
  • hõ rợ.xls
    hõ rợ.xls
    38.5 KB · Đọc: 5
Dùng Vba cũng được, theo mình đơn giản hơn bạn nên dùng Advance filter như anh Thương gợi ý. Tập dùng google cho quen, trên google có hướng dẫn rất cụ thể
 
Thời nay mà còn dùng đồ cổ .xls :p
Anh ơi Anh xem hộ em cái hàm My_Vlookup được không ạ
Em đang phải duyệt qua mảng kết quả để bỏ phần tử thừa rồi mới đưa vào hàm ResizeKQ. Do đó nó bị chậm một chút. Mong Anh xem giúp em nhé
 
Lần chỉnh sửa cuối:
Anh ơi Anh xem hộ em cái hàm My_Vlookup được không ạ
Em đang phải duyệt qua mảng kết quả để bỏ phần tử thừa rồi mới đưa vào hàm ResizeKQ. Do đó nó bị chậm một chút. Mong Anh xem giúp em nhé
Chậm không do duyệt mảng kết quả mà do mấy cái lùm xùm ép bảng tính, tính lại vùng dữ liệu
 
Trong Function nên bỏ bớt 1 vòng "For J=1 ..." theo cột
Dạ đúng rồi Anh ạ. Cám ơn Anh nhiều ạ
Em sửa lại như thế này
Mã:
Function My_Vlookup(ByVal Lookup_Value, ByVal Table_Array As Range, ByVal Col_Index As Long)
    Dim sArr(), tArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Idx As Long
sArr = Table_Array.value
ReDim tArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr)
    If Lookup_Value = sArr(I, Col_Index) Then
        K = K + 1:  tArr(K, 1) = I
    End If
Next I
R = K: K = 0
ReDim dArr(1 To R, 1 To UBound(sArr, 2))
For I = 1 To R
    K = K + 1: Idx = tArr(I, 1)
    For J = 1 To UBound(sArr, 2)
        dArr(K, J) = sArr(Idx, J)
    Next J
Next I
If K Then My_Vlookup = ResizeKQ(dArr)
End Function
 
Cái này chỉ việc filter rồi copy/paste visible lại từng chết thôi. Cốt kiếc thì cũng giải thuật đó. Làm tùm lùm chi cho mệt.

Giải thuật khác nếu cốt:
- copy cả sheet ra 1 sheet khác
- sort theo tên
- copy cả sheet ra từng sheet khác và dùng hàm Match(tên... để tìm dòng đầu, dùng Match(tên & "1"... để tìm dòng cuối
- delete các dòng còn lại.
 
Dạ đúng rồi Anh ạ. Cám ơn Anh nhiều ạ
Em sửa lại như thế này
Mã:
Function My_Vlookup(ByVal Lookup_Value, ByVal Table_Array As Range, ByVal Col_Index As Long)
    Dim sArr(), tArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Idx As Long
sArr = Table_Array.value
ReDim tArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr)
    If Lookup_Value = sArr(I, Col_Index) Then
        K = K + 1:  tArr(K, 1) = I
    End If
Next I
R = K: K = 0
ReDim dArr(1 To R, 1 To UBound(sArr, 2))
For I = 1 To R
    K = K + 1: Idx = tArr(I, 1)
    For J = 1 To UBound(sArr, 2)
        dArr(K, J) = sArr(Idx, J)
    Next J
Next I
If K Then My_Vlookup = ResizeKQ(dArr)
End Function
For I = 1 To R
K = K + 1: Idx = tArr(I, 1)
For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(Idx, J)
Next J
Next I
K = K + 1 không cần vì k luôn bằng I
Bỏ luôn R = K: K = 0
 
Code ở bài #18:
Trước sau gì bạn cũng phải duyệt hết mảng, chép nó ra mảng nhỏ chi cho mất công.

' 1 mảng, không hơn không kém
For rowS = 1 to UBound(a)
If ten = a(rowS, cotTen) Then
rowD = rowD + 1
a(rowD, 1) = rowD
For j = 2 To soCot
a(rowD , j) = a(rowS, j)
Next j
End If
Next i
' cắt mảng a cho đến số dòng rowD
 
Code ở bài #18:
Trước sau gì bạn cũng phải duyệt hết mảng, chép nó ra mảng nhỏ chi cho mất công.

' 1 mảng, không hơn không kém
For rowS = 1 to UBound(a)
If ten = a(rowS, cotTen) Then
rowD = rowD + 1
a(rowD, 1) = rowD
For j = 2 To soCot
a(rowD , j) = a(rowS, j)
Next j
End If
Next i
' cắt mảng a cho đến số dòng rowD
Cám ơn Thầy ạ. Nhưng em chưa biết cách cắt mảng do vậy mới phải ghi vào mảng tạm ạ. Thây hướng dẫn em với ạ
 
Cám ơn Thầy ạ. Nhưng em chưa biết cách cắt mảng do vậy mới phải ghi vào mảng tạm ạ. Thây hướng dẫn em với ạ
Không phải hàm này sao?
If K Then My_Vlookup = ResizeKQ(dArr)

Cả lại, cách dễ nhất để cắt bớt, hoặc thêm dòng cho một mảng vón đuọc chép ra từ range là tìm một range trống dưới bảng tính, chép mảng xuống, copy trở lại phần cần thiết rồi xoá đi.
 
Không phải hàm này sao?


Cả lại, cách dễ nhất để cắt bớt, hoặc thêm dòng cho một mảng vón đuọc chép ra từ range là tìm một range trống dưới bảng tính, chép mảng xuống, copy trở lại phần cần thiết rồi xoá đi.
Em cám ơn Thầy rất nhiều. Cách của Thầy hay quá ạ
Em đưa vào hàm ResizeKQ 2 tham số của mảng. Kết quả là nó ngắn cũn thật là dễ thương như thế này ạ
Mã:
Function My_Vlookup(ByVal MaTK, Table_Array As Range, Col_Index As Long)
    Dim sArr(), I As Long, J As Long, K As Long, C As Long
sArr = Table_Array.value
C = UBound(sArr, 2)
For I = 1 To UBound(sArr)
    If MaTK = sArr(I, Col_Index) Then
        K = K + 1
        For J = 1 To C
            sArr(K, J) = sArr(I, J)
        Next J
    End If
Next I
If K Then My_Vlookup = ResizeKQ(sArr, K, C)
End Function
 
à do định dang ;;; thôi em. em bấm vào định dạng format cell chọn cái khác là được
anh cho em hỏi chút cách nào đưa dư liệu người thưc hiện hợp đồng thahf 2 sheep khách nhau ko ạ

bảng anh làm em cũ anh lafmthi ok rồi ạ, có cách nào xử lý này ko ạ ( vị người thực hiện hiện ra luôn mr tùng: ra 1 sheet, sơn ra 1 sheet luôn
1587712113580.png
1587712132421.png
 

File đính kèm

Em cám ơn Thầy rất nhiều. Cách của Thầy hay quá ạ
Em đưa vào hàm ResizeKQ 2 tham số của mảng. Kết quả là nó ngắn cũn thật là dễ thương như thế này ạ
...
Chỉ căn bản thôi. Vấn đề là các bạn quen cách làm việc với cặp mảng sArr, dArr rồi nên không để ý.
Kỹ thuật dồn 1 mảng là kỹ thuật căn bản khi mảng đầu ra cùng dạng với mảng đầu vào.
 

File đính kèm

cả nhà giúp em với ạ, em muốn lọc dư liêu theo tên người thực hiện hợp đồng thành sheet riêng: tùng, miền, huỳnh, sơn ạ
View attachment 236350
Quá đơn giản. cho dù 100.000 dòng cũng không mất 2 giây

Mã:
Sub LOCcoban()
On Error Resume Next
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Col As Long
sArr = Range("A3:I13").Value '
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 9) '
For I = 1 To R
    If UCase(sArr(I, 8)) = UCase(Range("N2").Value) Then
        K = K + 1
        For Col = 1 To 9 '
            dArr(K, Col) = sArr(I, Col)
        Next Col
    End If
Next I

Range("A21").Resize(R, 9).ClearContents
Range("A21").Resize(K, 9) = dArr '
End Sub
 

File đính kèm

File đính kèm

cả nhà giúp em với ạ, em muốn lọc dư liêu theo tên người thực hiện hợp đồng thành sheet riêng: tùng, miền, huỳnh, sơn ạ
Cái này Dùng Advanced Filer thì code ngắn gọn, vào N2 chọn 1 tên để xem kết quả.
Còn muốn mỗi người 1 sheet thì cũng Advanced Filer nhưng làm cách khác và chỉ nhấn nút là xong.
 

File đính kèm

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

Back
Top Bottom