[已解决]两个数组之间如何筛选？

raulerini

如下面的代码，分别生成了两个数组，arr1={1,2,3,4,5,6,7,8,9}，arr2={2,4,6,8,10,12,14,16,18}，如何从arr1中筛选出arr2中有的数据组成一个新的数组？即生成{2,4,6,8}的新数组？

Sub test()
Dim arr1(1 To 9), arr2(1 To 9)
For i = 1 To 9
arr1(i) = i
arr2(i) = 2 * i
Next
End Sub

最佳答案

月排行榜 / 总排行榜

amulee

2010-6-29 09:45

前几天刚写过几段。

利用字典编写求两个数组的交集、并集和差集的函数

1、求交集

Function JiaoJi(ByVal Arr1, ByVal Arr2) '½»¼¯
    Dim d, d1, Temp
    Set d = CreateObject("Scripting.Dictionary")
    Set d1 = CreateObject("Scripting.Dictionary")
    For Each Temp In Arr1
        d1(Temp) = 1
    Next
    For Each Temp In Arr2
        If d1.exists(Temp) Then d(Temp) = 1
    Next
    JiaoJi = d.keys
End Function

2、求并集

Function BingJi(ByVal Arr1, ByVal Arr2) '²¢¼¯
    Dim d, Temp
    Set d = CreateObject("Scripting.Dictionary")
    For Each Temp In Arr1
        d(Temp) = 1
    Next
    For Each Temp In Arr2
        d(Temp) = 1
    Next
    BingJi = d.keys
End Function

3、求差集。所谓Arr1和Arr2差集，就是属于Arr1却不属于Arr2的数据集合：

Function ChaJi(ByVal Arr1, ByVal Arr2) 'Arr1与Arr2差集。属于Arr1却不属于Arr2的集合
    Dim d, d1, Temp
    Set d = CreateObject("Scripting.Dictionary")
    Set d1 = CreateObject("Scripting.Dictionary")
    For Each Temp In Arr2
        d1(Temp) = 1
    Next
    For Each Temp In Arr1
        If Not d1.exists(Temp) Then d(Temp) = 1
    Next
    ChaJi = d.keys
End Function

跳转到最佳答案楼层

amulee

前几天刚写过几段。

利用字典编写求两个数组的交集、并集和差集的函数

1、求交集

Function JiaoJi(ByVal Arr1, ByVal Arr2) '½»¼¯
    Dim d, d1, Temp
    Set d = CreateObject("Scripting.Dictionary")
    Set d1 = CreateObject("Scripting.Dictionary")
    For Each Temp In Arr1
        d1(Temp) = 1
    Next
    For Each Temp In Arr2
        If d1.exists(Temp) Then d(Temp) = 1
    Next
    JiaoJi = d.keys
End Function

2、求并集

Function BingJi(ByVal Arr1, ByVal Arr2) '²¢¼¯
    Dim d, Temp
    Set d = CreateObject("Scripting.Dictionary")
    For Each Temp In Arr1
        d(Temp) = 1
    Next
    For Each Temp In Arr2
        d(Temp) = 1
    Next
    BingJi = d.keys
End Function

3、求差集。所谓Arr1和Arr2差集，就是属于Arr1却不属于Arr2的数据集合：

Function ChaJi(ByVal Arr1, ByVal Arr2) 'Arr1与Arr2差集。属于Arr1却不属于Arr2的集合
    Dim d, d1, Temp
    Set d = CreateObject("Scripting.Dictionary")
    Set d1 = CreateObject("Scripting.Dictionary")
    For Each Temp In Arr2
        d1(Temp) = 1
    Next
    For Each Temp In Arr1
        If Not d1.exists(Temp) Then d(Temp) = 1
    Next
    ChaJi = d.keys
End Function

amulee

就是用字典来判断一个有，一个没有或有咯

EZD

阿木好帅呀。。。[em31]

yuhe0008

Sub test()
arr1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
arr2 = Array(2, 4, 6, 8, 10, 12, 14, 16, 18)
a = Join(arr1, ",")
For i = 0 To UBound(arr2)
If InStr(a, arr2(i)) Then s = s & arr2(i) & " "
Next
arr3 = Split(Trim(s), " ")
End Sub

raulerini

QUOTE:

以下是引用amulee在2010-6-29 9:45:00的发言：

前几天刚写过几段。

利用字典编写求两个数组的交集、并集和差集的函数

1、求交集

Function JiaoJi(ByVal Arr1, ByVal Arr2) '½»¼¯
    Dim d, d1, Temp
    Set d = CreateObject("Scripting.Dictionary")
    Set d1 = CreateObject("Scripting.Dictionary")
    For Each Temp In Arr1
        d1(Temp) = 1
    Next
    For Each Temp In Arr2
        If d1.exists(Temp) Then d(Temp) = 1
    Next
    JiaoJi = d.keys
End Function

2、求并集

Function BingJi(ByVal Arr1, ByVal Arr2) '²¢¼¯
    Dim d, Temp
    Set d = CreateObject("Scripting.Dictionary")
    For Each Temp In Arr1
        d(Temp) = 1
    Next
    For Each Temp In Arr2
        d(Temp) = 1
    Next
    BingJi = d.keys
End Function

3、求差集。所谓Arr1和Arr2差集，就是属于Arr1却不属于Arr2的数据集合：

Function ChaJi(ByVal Arr1, ByVal Arr2) 'Arr1与Arr2差集。属于Arr1却不属于Arr2的集合
    Dim d, d1, Temp
    Set d = CreateObject("Scripting.Dictionary")
    Set d1 = CreateObject("Scripting.Dictionary")
    For Each Temp In Arr2
        d1(Temp) = 1
    Next
    For Each Temp In Arr1
        If Not d1.exists(Temp) Then d(Temp) = 1
    Next
    ChaJi = d.keys
End Function

感谢阿木，细细研究了。。。

yuhe0008

Sub test()
arr1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
arr2 = Array(2, 4, 6, 8, 10, 12, 14, 16, 18)
Set x = CreateObject("scriptcontrol")
x.Language = "jscript"
x.eval ("function aa(aa) {return aa.toArray();}")
Set arr3 = x.eval("new Array();")
Set m = x.codeobject.aa(arr2)
For Each mm In m
If InStrRev(m, mm) <> InStr(m, mm) Then arr3.push mm
Next
MsgBox arr3 '很奇怪吧？JS出来的数组可以在VBA直接调用相关函数，但又可以直接MSGBOX显示所有元素
End Sub

raulerini

QUOTE:

以下是引用yuhe0008在2010-6-29 11:12:00的发言：

Sub test()
arr1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
arr2 = Array(2, 4, 6, 8, 10, 12, 14, 16, 18)
Set x = CreateObject("scriptcontrol")
x.Language = "jscript"
x.eval ("function aa(aa) {return aa.toArray();}")
Set arr3 = x.eval("new Array();")
Set m = x.codeobject.aa(arr2)
For Each mm In m
If InStrRev(m, mm) <> InStr(m, mm) Then arr3.push mm
Next
MsgBox arr3 '很奇怪吧？JS出来的数组可以在VBA直接调用相关函数，但又可以直接MSGBOX显示所有元素
End Sub

用到JS了。。[em06][em06][em06][em06][em06][em06]看不太懂

CCTV20082008

[em17][em17]