vba交集代码怎么在EXCEL中运用vba交集代码怎么在表格EXECL中运用?下面这个是VBA交集代码不知道是否正确,Functionf(x,y)DimdicAsObjectSetdic=CreateObject("Scripting.Dictionary")x=Replace(x,"£¬",",")y=

Question

vba交集代码怎么在EXCEL中运用
vba交集代码怎么在表格EXECL中运用?下面这个是VBA交集代码不知道是否正确,
Function f(x,y)
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
x = Replace(x,"£¬",",")
y = Replace(y,"£¬",",")
a = Split(x,",")
b = Split(y,",")
For i = 0 To UBound(a) - 1
dic(a(i)) = ""
Next i
For i = 0 To UBound(b) - 1
If dic.exists(b(i)) Then f = f & b(i) & ","
Next i
Set dic = Nothing
End Function
A1=01,02,05,07,09
A2=02,05,08,13
A3=04,05,12,16,19
A4=03,05,18,19
A5=01,05,11,17,20
A6=1.2.5.6.9.10.22
A7=5.13.16.19.26.24
A8=3.5.10.11.15.17
求这8组数据的交集,

Answer 1

Public Function getJiaoJi(rng As Range) As String

On Error GoTo L_end

    Dim d1 As Dictionary, d2 As Dictionary

    Set d1 = New Dictionary: Set d2 = New Dictionary

    Dim cel As Range

    Dim tempstr() As String,temp as string 

    Dim star As Boolean

    Dim i As Integer

    Dim ky As Variant

    For Each cel In rng

        temp = cel.value

        if instr(1,temp ,".")>0 then temp = temp.replace(temp ,".",",")

        tempstr = Split(temp , ",")

        For i = 0 To UBound(tempstr)

            If star Then

                If d2.Exists(tempstr(i)) Then

                    If Not d1.Exists(tempstr(i)) Then Call d1.Add(tempstr(i), tempstr(i))

                Else

                    

                End If

            Else

                If Not d1.Exists(tempstr(i)) Then Call d1.Add(tempstr(i), tempstr(i))

                If Not d2.Exists(tempstr(i)) Then Call d2.Add(tempstr(i), tempstr(i))

            End If

        Next

        star = True

        d2.RemoveAll

        For Each ky In d1.Keys

            Call d2.Add(ky, ky)

        Next

        d1.RemoveAll

    Next

    

    Dim str1 As String

    For Each ky In d2.Keys

        If str1 = "" Then

            str1 = ky

        Else

            str1 = str1 & "," & ky

        End If

    Next

    getJiaoJi = str1

Exit Function

L_end:

    getJiaoJi = "err:" & Err.Description

End Function