返回列表 上一主題 發帖

[發問] 請問如何一个條件匹配多个結果(去重複)

[發問] 請問如何一个條件匹配多个結果(去重複)

本帖最後由 hycn 於 2020-11-8 09:58 編輯

請問一个条件匹配多个结果並去重複
這 VBA Function 函數要如何修改
因為E欄單元格條件匹配是希望去重複並有" , "符號隔開

在此先言謝 ~

一個條件匹配多個結果(去重複).rar (10.65 KB)

隨意窩 "EXCEL迷"  blog  或 http://blog.xuite.net/hcm19522/twblog
已收集7000篇 EXCEL函數

TOP

回復 1# hycn


    Sub test()
    Dim arr, 棋盤(1 To 2000, 1 To 2), i%
    Dim d As Object, d1 As Object
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    arr = Range("b1", [a65536].End(xlUp))

    For i = 1 To UBound(arr)
        xR = arr(i, 1) & arr(i, 2)
        If d.Exists(arr(i, 1)) Then
            If d1.Exists(xR) Then GoTo 100
            列 = d(arr(i, 1))
            棋盤(列, 2) = 棋盤(列, 2) & "," & arr(i, 2)
        Else
            k = k + 1
            d(arr(i, 1)) = k
            棋盤(k, 1) = arr(i, 1)
            棋盤(k, 2) = arr(i, 2)
        End If
        d1(xR) = arr(i, 1) & arr(i, 2)
100:    Next
    Range("D1").Resize(k, 2) = 棋盤
End Sub

TOP

回復 1# hycn

Function abc(a As Range, b As Range, c$) As String
Dim Ta$, Tb$, TT$
If a.Count <> b.Count Then abc = "error": Exit Function
If c = "" Then Exit Function
For i = 1 To a.Count
    Ta = a(i, 1):  Tb = b(i, 1)
    If Ta <> c Or Tb = "" Then GoTo 101
    If InStr("," & TT & ",", "," & Tb & ",") = 0 Then TT = TT & "," & Tb  '比對b文字是否已存在于TT字串中
101: Next
abc = Mid(TT, 2)
End Function

TOP

        靜思自在 : 人生沒有所有權,只有生命的使用權。
返回列表 上一主題