Hàm tra cứu theo chuỗi nhập vào (1 người xem)

Liên hệ QC

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

bugatino

Thành viên chính thức
Tham gia
14/7/10
Bài viết
54
Được thích
3
Chào các bạn GPE,

Mình có 1 bảng tính như sau:
2013-10-20 14_13_50-Tra cuu trong 1 vung du lieu - Excel.jpg

Mục đích của mình là khi người dùng nhập vào chuỗi danh sách lớp vào ô B1 thì sẽ trả về danh sách QLHT phụ trách những lớp đó ở ô B2.

Ví dụ: B1 nhập vào B2-C4-C2-D4-D7-E2-B8 thì B2 sẽ trả về: QLHT2 (B2-C2-E2): 0911111111, QLHT4 (C4-D4): 0913333333, QLHT7 (D7): 0916666666, QLHT8 (B8): 0917777777.

Các bạn giúp mình viết function tổng hợp dữ liệu theo chuỗi nhập vào ở ô B1 với. Cám ơn các bạn rất nhiều.
 

File đính kèm

Lập công thức ngay trong sheet thì mình thấy nó quá dài nên chuyển sang dùng Macro.
Bạn xem file này thế nào nhé?
Link MediaFire: Tra cuu trong 1 vung du lieu (macro)
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn bạn phucbugis đã giúp mình giải quyết bài toán này. Cách của bạn khá ok nhưng phải tạo thêm cột và mảng nên chưa đúng với mong muốn của mình lắm vì vậy mình đã tự mày mò viết function dựa vào bài viết này: http://www.giaiphapexcel.com/forum/showthread.php?60643-Tổng-quan-về-Dictionary.

Mình xin đưa function lên cho những ai quan tâm:
PHP:
Function TraCuuQLHT(ByVal strLop As Range, ByVal Rng As Range)
    Dim Arr As Variant, tempArr As Variant, ArrLop As Variant
    Dim i, j, k, n, m As Integer
    Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    Dim strKQ As String

   tempArr = Rng.Value
   ArrLop = Split(strLop.Value, "-")
    ReDim Arr(0 To UBound(ArrLop, 1), 2)
   For i = 0 To UBound(ArrLop, 1)
        For j = 1 To UBound(tempArr, 1)
            For k = 3 To UBound(tempArr, 2)
                If tempArr(j, k) = ArrLop(i) And Not Dic.exists(tempArr(j, 1)) Then
                    n = n + 1
                    Dic.Add tempArr(j, 1), n
                    Arr(n, 0) = tempArr(j, 1)
                    Arr(n, 1) = tempArr(j, 2)
                    Arr(n, 2) = tempArr(j, k)
                ElseIf tempArr(j, k) = ArrLop(i) And Dic.exists(tempArr(j, 1)) Then
                    Arr(Dic.Item(tempArr(j, 1)), 2) = Arr(Dic.Item(tempArr(j, 1)), 2) & "-" & tempArr(j, k)
                End If
            Next k
        Next j
    Next i
   For m = 0 To UBound(Arr, 1)
        If Arr(m, 0) <> "" Then
            strKQ = strKQ & ", " & Arr(m, 0) & " (" & Arr(m, 2) & "): " & Arr(m, 1)
        End If
    Next m
   strKQ = Right(strKQ, Len(strKQ) - 2)
   TraCuuQLHT = strKQ
End Function
 
Lần chỉnh sửa cuối:
Upvote 0

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

Back
Top Bottom