Lọc trùng trong 1 ô

hoalv1985 · 29/11/21

Em nhờ các anh/ chị trong diễn đàn giúp em bài toán này với ạ. Em sử dụng hàm ( giống hàm vlookup) trả về nhiều giá trị ( ở cột b sheets(" kiem tra"). Nhưng khi sử dụng hàm đó thì trả về kết quả trùng trong 1 ô. Em muốn chỉ lấy giá trị khác nhau thôi ạ. Kết quả mong muốn em để ví dụ ở cột C ạ. Em cảm ơn Anh/ chị nhiều ạ!

Phuocam · 29/11/21

hoalv1985 đã viết:
Em nhờ các anh/ chị trong diễn đàn giúp em bài toán này với ạ. Em sử dụng hàm ( giống hàm vlookup) trả về nhiều giá trị ( ở cột b sheets(" kiem tra"). Nhưng khi sử dụng hàm đó thì trả về kết quả trùng trong 1 ô. Em muốn chỉ lấy giá trị khác nhau thôi ạ. Kết quả mong muốn em để ví dụ ở cột C ạ. Em cảm ơn Anh/ chị nhiều ạ!

Thử thêm như sau:

PHP:

Function HyVlookUp(lookup_value, lookup_range As Range, index_col As Long) As String
    Dim x As Range, temp As String
    Dim result As String

    For Each x In lookup_range
        If x.Value = lookup_value Then
            temp = x.Offset(0, index_col - 1).Value
            If InStr(1, result & ",", "," & temp & ",") = 0 Then result = result & "," & temp
        End If
    Next
    If Len(result) > 0 Then HyVlookUp = VBA.Mid(result, 2)
End Function

UDF này xử lý chậm vì làm việc trên range.

.

hoalv1985 · 29/11/21

Phuocam đã viết:

Thử thêm như sau:

PHP:

Function HyVlookUp(lookup_value, lookup_range As Range, index_col As Long) As String
    Dim x As Range, temp As String
    Dim result As String

    For Each x In lookup_range
        If x.Value = lookup_value Then
            temp = x.Offset(0, index_col - 1).Value
            If InStr(1, result & ",", "," & temp & ",") = 0 Then result = result & "," & temp
        End If
    Next
    If Len(result) > 0 Then HyVlookUp = VBA.Mid(result, 2)
End Function

UDF này xử lý chậm vì làm việc trên range.

.

Em cảm ơn anh/ chị nhiều ạ. Chúc anh/ chị tuần làm việc vui vẻ và hạnh phúc ạ!

BuiQuangThuan · 29/11/21

hoalv1985 đã viết:
Em nhờ các anh/ chị trong diễn đàn giúp em bài toán này với ạ. Em sử dụng hàm ( giống hàm vlookup) trả về nhiều giá trị ( ở cột b sheets(" kiem tra"). Nhưng khi sử dụng hàm đó thì trả về kết quả trùng trong 1 ô. Em muốn chỉ lấy giá trị khác nhau thôi ạ. Kết quả mong muốn em để ví dụ ở cột C ạ. Em cảm ơn Anh/ chị nhiều ạ!

Mã:

Sub ABC()
Dim Dic As Object, i&
Set Dic = CreateObject("Scripting.dictionary")
With Sheet1
    arr = .Range("B2:B45").Value
    ReDim res(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        t = Split(arr(i, 1), ",")
        For ii = 0 To UBound(t)
            If Dic.exists(t(ii)) = False Then
                Dic.Add t(ii), ""
            End If
        Next
        For Each Key In Dic.keys
                tt = tt & "," & Key
        Next
        res(i, 1) = tt
        tt = "": Dic.RemoveAll
    Next
    .Range("C2").Resize(UBound(arr)).Value = res
End With
End Sub

Dùng tạm code này coi thế nào

hoalv1985 · 29/11/21

BuiQuangThuan đã viết:

Mã:

Sub ABC()
Dim Dic As Object, i&
Set Dic = CreateObject("Scripting.dictionary")
With Sheet1
    arr = .Range("B2:B45").Value
    ReDim res(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        t = Split(arr(i, 1), ",")
        For ii = 0 To UBound(t)
            If Dic.exists(t(ii)) = False Then
                Dic.Add t(ii), ""
            End If
        Next
        For Each Key In Dic.keys
                tt = tt & "," & Key
        Next
        res(i, 1) = tt
        tt = "": Dic.RemoveAll
    Next
    .Range("C2").Resize(UBound(arr)).Value = res
End With
End Sub

Dùng tạm code này coi thế nào

Dạ anh, code này trả về kết quả có dấu , trước tiên a à.

BuiQuangThuan · 29/11/21

hoalv1985 đã viết:
Dạ anh, code này trả về kết quả có dấu , trước tiên a à.

Viết vội. Bạn có thể tinh chỉnh lại

hoalv1985 · 29/11/21

BuiQuangThuan đã viết:
Viết vội. Bạn có thể tinh chỉnh lại

Dạ anh, Em chỉnh lại được rồi a ạ. Em cảm ơn a ạ!

befaint · 29/11/21

BuiQuangThuan đã viết:
For Each Key In Dic.keys
tt = tt & "," & Key
Next

Có Keys rồi thì mình dùng Join là được.
kết quả = VBA.join(Dic.Keys, dấu phân cách)

HieuCD · 29/11/21

Phuocam đã viết:

Thử thêm như sau:

PHP:

Function HyVlookUp(lookup_value, lookup_range As Range, index_col As Long) As String
    Dim x As Range, temp As String
    Dim result As String

    For Each x In lookup_range
        If x.Value = lookup_value Then
            temp = x.Offset(0, index_col - 1).Value
            If InStr(1, result & ",", "," & temp & ",") = 0 Then result = result & "," & temp
        End If
    Next
    If Len(result) > 0 Then HyVlookUp = VBA.Mid(result, 2)
End Function

UDF này xử lý chậm vì làm việc trên range.

Chậm do phải chạy For Each nhiều lần, mỗi lần chạy trên 6 cột

Bài đã được tự động gộp: 29/11/21

BuiQuangThuan đã viết:

Mã:

Sub ABC()
Dim Dic As Object, i&
Set Dic = CreateObject("Scripting.dictionary")
With Sheet1
    arr = .Range("B2:B45").Value
    ReDim res(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        t = Split(arr(i, 1), ",")
        For ii = 0 To UBound(t)
            If Dic.exists(t(ii)) = False Then
                Dic.Add t(ii), ""
            End If
        Next
        For Each Key In Dic.keys
                tt = tt & "," & Key
        Next
        res(i, 1) = tt
        tt = "": Dic.RemoveAll
    Next
    .Range("C2").Resize(UBound(arr)).Value = res
End With
End Sub

Dùng tạm code này coi thế nào

arr = .Range("B2:B45").Value
Cột B không có chỉ có dữ liệu cột A cần gán kết quả res vào cột B

VetMini · 29/11/21

Phuocam đã viết:
Thử thêm như sau:

PHP:

... For Each x In lookup_range ...

UDF này xử lý chậm vì làm việc trên range.

.

For Each x In lookup_range.Resize(, 1)

Tuy nhiên nếu cần phải đi tuần tự cả range thì dùng hàm Find-FindNext căn bản của VBA hiệu quả hơn.

Phuocam · 29/11/21

VetMini đã viết:
Tuy nhiên nếu cần phải đi tuần tự cả range thì dùng hàm Find-FindNext căn bản của VBA hiệu quả hơn.

Code này giữ nguyên gốc theo code cũ của tác giả. Trường hợp này có sẵn code JoinText và JoinIf của Lão Ẹc ẹc rồi. Hahaha...

Hàm nối chuổi theo điều kiện

Xin chào các bạn,đầu xuân chúc các bạn luôn mạnh khỏe,luôn hạnh phúc và đạt nhiều thành công trong cuộc sống. Tôi có một bài toán đã đề cập trong file kèm, các bạn xem và giúp mình với. Cảm ơn!

www.giaiphapexcel.com

.

HieuCD · 29/11/21

Phuocam đã viết:
Code này giữ nguyên gốc theo code cũ của tác giả. Trường hợp này có sẵn code JoinText và JoinIf của Lão Ẹc ẹc rồi. Hahaha...

Hàm nối chuổi theo điều kiện

Xin chào các bạn,đầu xuân chúc các bạn luôn mạnh khỏe,luôn hạnh phúc và đạt nhiều thành công trong cuộc sống. Tôi có một bài toán đã đề cập trong file kèm, các bạn xem và giúp mình với. Cảm ơn!

www.giaiphapexcel.com

.

Hàm khá đa dụng nhưng tốc độ vẫn còn chậm lắm lắm ... nên viết lại cho từng trường hợp nhằm tăng tốc như xe đua F1

VetMini · 30/11/21

HieuCD đã viết:
Hàm khá đa dụng nhưng tốc độ vẫn còn chậm lắm lắm ... nên viết lại cho từng trường hợp nhằm tăng tốc như xe đua F1

Người chủ code đã rời diễn đàn lâu ròi cho nên tôi tránh phê bình nhiều. Tuy nhiên, vì bạn nhắc cho nên tôi có những lời về cách quản lý code sau đây:

Loại hàm làm nhiều công việc thế này người ta chia thành nhiều hàm. Mỗi hàm chuyên về phần của nó, và có thể gọi các hàm con chung nếu trùng code. Hàm chuyên thì publicv, hàm con chia code thì private.
Sau đó nếu muốn tổng quát thì viết một hàm tổng, tự xét trường hợp một gọi hàm chuyên. Chứ viết một hàm từ a đến z mà không chú thích đầy đủ thì người ngoài lười đọc code lắm.

Lọc trùng trong 1 ô

hoalv1985

Thành viên hoạt động

File đính kèm

Phuocam

Thành viên mới

hoalv1985

Thành viên hoạt động

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

hoalv1985

Thành viên hoạt động

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

hoalv1985

Thành viên hoạt động

befaint

|||||||||||||

HieuCD

Chuyên gia GPE

VetMini

Ăn cùng góc phố

Phuocam

Thành viên mới

Hàm nối chuổi theo điều kiện

HieuCD

Chuyên gia GPE

Hàm nối chuổi theo điều kiện

VetMini

Ăn cùng góc phố

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

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng