Bỏ trùng lặp từ 2 dòng khác nhau. (5 người xem)

  • Thread starter Thread starter kh0jy3n
  • Ngày gửi Ngày gửi
Liên hệ QC

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

kh0jy3n

Thành viên thường trực
Tham gia
21/4/12
Bài viết
345
Được thích
115
Gửi Thầy & các bác.

Em có một file cần bỏ trùng lặp từ 2 dòng khác nhau cụ thể ở file là Cột B & H , kết quả trả về là cột M ( Shet Nhập - Xuất)

Thầy và mấy bác rảnh làm hộ em mới ạ. ở một cột thì em giải quyết được mà ở 2 cột khác nhau như này em potay ạ.

Em cảm ơn!

Em Khởi .
 

File đính kèm

Gửi Thầy & các bác.

Em có một file cần bỏ trùng lặp từ 2 dòng khác nhau cụ thể ở file là Cột B & H , kết quả trả về là cột M ( Shet Nhập - Xuất)

Thầy và mấy bác rảnh làm hộ em mới ạ. ở một cột thì em giải quyết được mà ở 2 cột khác nhau như này em potay ạ.

Em cảm ơn!

Em Khởi .
Vậy thì dùng VBA cho nhanh.:D
 
Gửi Thầy & các bác.

Em có một file cần bỏ trùng lặp từ 2 dòng khác nhau cụ thể ở file là Cột B & H , kết quả trả về là cột M ( Shet Nhập - Xuất)

Thầy và mấy bác rảnh làm hộ em mới ạ. ở một cột thì em giải quyết được mà ở 2 cột khác nhau như này em potay ạ.

Em cảm ơn!

Em Khởi .
Phải là bỏ trùng từ 2 cột chứ sao là 2 dòng?
Bạn chạy thử Sub này coi sao.
PHP:
Public Sub sGpe()
Dim sArr(), Arr(1 To 10000, 1 To 1), I As Long, K As Long, R As Long
With CreateObject("Scripting.Dictionary")
    '-------------------Cot H'
    sArr = Range("H3", Range("H3").End(xlDown)).Value
    R = UBound(sArr)
    For I = 1 To R
        If Not .Exists(sArr(I, 1)) Then
            K = K + 1
            .Item(sArr(I, 1)) = ""
            Arr(K, 1) = sArr(I, 1)
        End If
    Next I
    '-------------------Cot B'
    sArr = Range("B3", Range("B3").End(xlDown)).Value
    R = UBound(sArr)
    For I = 1 To R
        If Not .Exists(sArr(I, 1)) Then
            K = K + 1
            .Item(sArr(I, 1)) = ""
            Arr(K, 1) = sArr(I, 1)
        End If
    Next I
End With
Range("M3").Resize(K) = Arr
End Sub
 
Bạn chạy thử Sub này coi sao.
PHP:
Public Sub sGpe()
Dim sArr(), Arr(1 To 10000, 1 To 1), I As Long, K As Long, R As Long
With CreateObject("Scripting.Dictionary")
    '-------------------Cot H'
    sArr = Range("H3", Range("H3").End(xlDown)).Value
    R = UBound(sArr)
    For I = 1 To R
        If Not .Exists(sArr(I, 1)) Then
            K = K + 1
            .Item(sArr(I, 1)) = ""
            Arr(K, 1) = sArr(I, 1)
        End If
    Next I
    '-------------------Cot B'
    sArr = Range("B3", Range("B3").End(xlDown)).Value
    R = UBound(sArr)
    For I = 1 To R
        If Not .Exists(sArr(I, 1)) Then
            K = K + 1
            .Item(sArr(I, 1)) = ""
            Arr(K, 1) = sArr(I, 1)
        End If
    Next I
End With
Range("M3").Resize(K) = Arr
End Sub
Dạ
Em chỉ có thể nói về code này bằng 3 từ ( Tuyệt cú mèo) :D .
Em cảm ơn nhiều ạ.
Chúc bác có một tuần làm việc v v ạ .
 
Nếu chỉ lấy 1 lần sao bạn không copy rồi Data | Remove Duplicate
 
Web KT

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

Back
Top Bottom