Lọc tài liệu (2 người xem)

[giangvqpp]

Thanks ca nha nhieu!!!!!!!

 

[ninhtindcd]

mình chưa hiếu ý bạn lắm

 

[giangvqpp]

Tức là tài liệu có nhiều phiên bản khác nhau nhưng mình cần giữ lại phiên bản cuối cùng đối với từng bản vẽ một

 

[phucbugis]

Dear all
Mình có một file excel quản lý tài liệu thiết kế như đính kèm; Vấn đề của mình là muốn lọc ra các bản vẽ giống nhau nhưng chỉ lấy phiên bản cuối cùng các phiên bản khác bỏ đi; thứ tự phiên bản từ chữ cái đến số tức là phiên bản đầu sẽ là A tiếp theo là B rồi hết chữ cái sẽ đến số bắt đầu từ 0 rồi đến 1,2...; Vì số lượng rất lớn nên cần làm code để lọc cho nhanh mà mình vẫn chưa làm được mong mọi người giúp đỡ.

bạn tải file đính kèm,
- việc lọc theo yêu cầu như bạn diễn đạt thì vẫn chưa cần dùng đến Macro nhé !
- công thức hoàn chỉnh tại cột H, bạn lọc riêng cột đó ra với điều kiện <> dấu , rồi copy đi đâu đó thì tuỳ

Link: https://www.mediafire.com/?506692h8d058xj0

 

[Ba Tê]

Tức là tài liệu có nhiều phiên bản khác nhau nhưng mình cần giữ lại phiên bản cuối cùng đối với từng bản vẽ một

Kiểm tra kết quả của file này xem, không trong ngành không nhìn nỗi.

 

[dhn46]

Một cách để bạn tham khảo

Sub Loc()
    Dim Arr, Res
    Dim i As Long, j As Long, k As Long, Tmp, Tmp1
    Dim Dk1 As Long, Dk2 As Long
    Arr = Sheets("DATA").Range("A2:C" & Sheets("DATA").[C65536].End(3).Row)
    ReDim Res(1 To UBound(Arr, 1), 1 To 3)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Arr, 1)
            If Not .Exists(Arr(i, 1)) Then
                k = k + 1
                .Add Arr(i, 1), k
                Res(k, 1) = Arr(i, 1)
                Res(k, 2) = Arr(i, 2)
                Res(k, 3) = Arr(i, 3)
            End If
        Next
        For i = 1 To UBound(Arr, 1)
            Tmp = UCase(Res(.Item(Arr(i, 1)), 3))
            Dk1 = IIf(IsNumeric(Tmp), Asc(Tmp) + 20, Asc(Tmp) - 64)
            Tmp1 = UCase(Arr(i, 3))
            Dk2 = IIf(IsNumeric(Tmp1), Asc(Tmp1) + 20, Asc(Tmp1) - 64)
            If Dk1 < Dk2 Then
                Res(.Item(Arr(i, 1)), 3) = Arr(i, 3)
            End If
        Next
        Sheets("Data").Range("F2").Resize(k, 3) = Res
    End With
End Sub

 

[giangvqpp]

À quên còn thêm một cột thứ 4 nữa nhưng cột này chỉ giống như cột thứ 2 thôi sửa giúp để copy cột đó luôn cái nhé

 

[phucbugis]

À quên còn thêm một cột thứ 4 nữa nhưng cột này chỉ giống như cột thứ 2 thôi sửa giúp để copy cột đó luôn cái nhé

- bạn nên trích dẫn là đang nhờ thành viên nào?
- mọi người đều nhiệt tình thức đến 11hxx đêm để giúp bạn, mà bây giờ bạn trả lời vậy thì riêng mình là ko chiu. nổi