配列同士の値を比較して差分を別の配列に格納する方法

実現したいこと

VBAにて、以下2点を実現したいと考えております。
・2つの配列同士の値を比較して差分を抽出
・差分含む全ての値を別の配列に格納する

質問

配列1の値には、[1、2、3、4、7]
配列2の値には、[1、2、3、5、6、8]

・共通の値:1、2、3
・配列1にしかない値:4、7
・配列2にしかない値:5、6、8

→配列3:[1、2、3、4、5、6、7、8]

上記の例のように、
配列1と配列2の値を比較することで差分を確認して、共通の値と差分の値を別の配列3に格納するにはどうすれば良いのでしょうか？

初歩的な質問でしたらすみませんが、ご教示いただけないでしょうか。、

よろしくお願いいたします。

yambejp

2023/06/16 06:06

配列1,2には各配列内に同じ値は絶対にないのでしょうか？配列1にしかない7はなぜ配列3に引き継がれないのですか？

sdnco

2023/06/16 06:10

すみません、配列3の値で7がないのは記載漏れです。修正しました。

sdnco

2023/06/16 06:13

>> 配列1,2には各配列内に同じ値は絶対にないのでしょうか？同じ値はないようにしたいです。

yambejp

2023/06/16 06:54

VBAの配列は制約多いですが、配列の宣言は具体的にどうやっていますか？現状できているところまで質問に追記ください

hatena19

2023/06/16 08:15

配列1、配列2から、配列3を生成すればいいのでしょうか(つまり、重複を排除したユニークな値の配列の生成)。それとも、共通の値の配列, 配列1にしかない値の配列, 配列2にしかない値の配列も必要なのでしょうか。前者であれば、連想配列(Dictionary)に各配列の要素を追加していくだけでできます。あるいは、Office365なら Unique関数で簡単に求められます。

otn

2023/06/17 05:19 編集

配列1、2から配列3を作るだけなら、「配列1と配列2の値を比較することで差分を確認して、共通の値と差分の値」とかは全く不要な作業ですが、配列3以外に、共通の値を配列Aに配列1にしかない値を配列Bに配列2にしかない値を配列Cにとか保存が必要のでしょうか？配列3だけが必要ならそんなことはせずに単に配列1と配列2をマージすればいいだけだと思いますが。配列3の中味は順不同なのか、「こういう順になっていて欲しい」という要件があるのかが不明。

行動規範の内容に同意します

回答4件

vba
1Option Explicit
2Function ArrDif(arr1, arr2) 'As Scripting.Dictionary
3   '二つの配列を比較し、辞書形式で返す
4   '0: 配列1と配列2の両方に存在
5   '1: 配列1のみに存在
6   '2: 配列2のみに存在
7   
8    Dim d, w, v
9    Set d = CreateObject("Scripting.Dictionary")
10    Set w = CreateObject("Scripting.Dictionary")
11    
12    For Each v In arr1
13        d(v) = 1
14        w(v) = v
15    Next
16    For Each v In arr2
17        If w.Exists(v) Then
18            d(v) = 0
19        Else
20            d(v) = 2
21        End If
22    Next
23    Set ArrDif = d
24End Function

vba
1Sub Test()
2    Dim array1, array2
3    array1 = Array(1, 2, 3, 4, 7)
4    array2 = Array(1, 2, 3, 5, 6, 8)
5    Dim dic, k
6    Set dic = ArrDif(array1, array2)
7    For Each k In dic
8        Debug.Print k, dic(k)
9    Next
10End Sub

投稿2023/07/12 00:06

jinoji

総合スコア4592

vba
1Option Explicit
2Function Sabun(arr1, arr2, Optional mode = 0)
3   ' 二つの配列から動作モードに従って新たな配列を返す関数
4   ' 0:配列１と配列２に共通
5   ' 1:配列１のみに存在
6   ' 2:配列２のみに存在
7   ' 3:配列１と配列２をマージ
8
9    Dim kyotu, only1, only2, merge, v
10    Set kyotu = CreateObject("Scripting.Dictionary")
11    Set only1 = CreateObject("Scripting.Dictionary")
12    Set only2 = CreateObject("Scripting.Dictionary")
13    Set merge = CreateObject("Scripting.Dictionary")
14    
15    For Each v In arr1
16        merge(v) = v
17        only1(v) = v
18    Next
19    For Each v In arr2
20        merge(v) = v
21        If only1.Exists(v) Then
22            kyotu(v) = v
23            only1.Remove v
24        Else
25            only2(v) = v
26        End If
27    Next
28    Select Case mode
29        Case 1: Sabun = only1.Keys
30        Case 2: Sabun = only2.Keys
31        Case 3: Sabun = merge.Keys
32        Case Else: Sabun = kyotu.Keys
33    End Select
34End Function

vba
1Sub Sample()
2    Dim array1, array2, array3, i
3    array1 = Array(1, 2, 3, 4, 7)
4    array2 = Array(1, 2, 3, 5, 6, 8)
5    For i = 0 To 3
6        array3 = Sabun(array1, array2, i)
7        Debug.Print i, Join(array3, vbTab)
8    Next
9End Sub

投稿2023/07/11 23:27

編集2023/07/11 23:42

jinoji

総合スコア4592

配列1、配列2から、配列3を生成するだけなら、下記で可能です。

vba
1Sub Sample()
2
3    Dim Array1() As Variant
4    Dim Array2() As Variant
5    Array1 = Array(1, 2, 3, 4, 7)
6    Array2 = Array(1, 2, 3, 5, 6, 8)
7    
8    Dim Dic As Object
9    Set Dic = CreateObject("Scripting.Dictionary")
10    
11    Dim I As Variant
12    For Each I In Array1
13       Dic(I) = 1
14    Next
15    For Each I In Array2
16       Dic(I) = 1
17    Next
18
19    Debug.Print "配列3: " & Join(Dic.Keys, ",")
20End Sub

共通の値の配列, 配列1にしかない値の配列, 配列2にしかない値の配列も必要なのなら、

vba
1Sub Sample2()
2
3    Dim Array1() As Variant
4    Dim Array2() As Variant
5    Array1 = Array(1, 2, 3, 4, 7)
6    Array2 = Array(1, 2, 3, 5, 6, 8)
7    
8    Dim Dic As Object
9    Set Dic = CreateObject("Scripting.Dictionary")
10    
11    Dim I As Variant
12    For Each I In Array1
13       Dic(I) = "a"
14    Next
15    For Each I In Array2
16       Dic(I) = Dic(I) & "b"
17    Next
18   
19    Dim ArrayIn() As Variant, cntIn As Long
20    Dim ArrayDif1() As Variant, cntDif1 As Long
21    Dim ArrayDif2() As Variant, cntDif2 As Long
22    Dim K As Variant
23    For Each K In Dic.Keys
24        Select Case Dic.Item(K)
25        Case "ab"
26            ReDim Preserve ArrayIn(cntIn)
27            ArrayIn(cntIn) = K
28            cntIn = cntIn + 1
29        Case "a"
30            ReDim Preserve ArrayDif1(cntDif1)
31            ArrayDif1(cntDif1) = K
32            cntDif1 = cntDif1 + 1
33        Case "b"
34            ReDim Preserve ArrayDif2(cntDif2)
35            ArrayDif2(cntDif2) = K
36            cntDif2 = cntDif2 + 1
37        End Select
38    Next
39    
40    Debug.Print "共通の値: " & Join(ArrayIn, ",")
41    Debug.Print "配列1にしかない値: " & Join(ArrayDif1, ",")
42    Debug.Print "配列2にしかない値: " & Join(ArrayDif2, ",")
43    Debug.Print "配列3: " & Join(Dic.Keys, ",")
44End Sub

投稿2023/06/16 12:48

編集2023/06/16 13:17

hatena19

総合スコア34343

vba
1Sub Test()
2
3    Dim varSourceArray1() As Variant
4    Dim varSourceArray2() As Variant
5    
6    varSourceArray1 = Array(1, 2, 3, 4, 7)
7    varSourceArray2 = Array(1, 2, 3, 5, 6, 8)
8    
9    Dim varIntersection As Variant
10    Dim varDifference1 As Variant
11    Dim varDifference2 As Variant
12    Dim varUnion As Variant
13
14    varIntersection = DistinctArray(IntersectionArray(varSourceArray1, varSourceArray2))
15    varDifference1 = DistinctArray(DifferenceArray(varSourceArray1, varSourceArray2))
16    varDifference2 = DistinctArray(DifferenceArray(varSourceArray2, varSourceArray1))
17    varUnion = DistinctArray(UnionArray(varSourceArray1, varSourceArray2))
18
19    Debug.Print "共通の値: " & Join(varIntersection, ",")
20    Debug.Print "配列1にしかない値: " & Join(varDifference1, ",")
21    Debug.Print "配列2にしかない値: " & Join(varDifference2, ",")
22    Debug.Print "配列1と配列2の和集合: " & Join(varUnion, ",")
23
24End Sub
25
26'1次元配列から重複する要素を取り除いた配列を返す関数
27Function DistinctArray(SourceArray() As Variant) As Variant()
28
29    Dim objDictionary As Object
30    
31    Set objDictionary = CreateObject("Scripting.Dictionary")
32    objDictionary.CompareMode = vbBinaryCompare
33    
34    Dim varNewArray() As Variant
35    Dim varItem As Variant
36    Dim lngItemCount As Long
37    
38    For Each varItem In SourceArray
39        If Not objDictionary.Exists(varItem) Then
40            objDictionary.Add varItem, varItem
41            ReDim Preserve varNewArray(0 To lngItemCount)
42            varNewArray(lngItemCount) = varItem
43            lngItemCount = lngItemCount + 1
44        End If
45    Next
46    
47    DistinctArray = varNewArray
48
49    Set objDictionary = Nothing
50    
51End Function
52
53'2つの1次元配列 Array1 と Array2 に共通する要素のみで構成された配列を返す関数
54Function IntersectionArray(Array1() As Variant, Array2() As Variant) As Variant()
55
56    Dim varNewArray() As Variant
57    Dim varItem1 As Variant
58    Dim varItem2 As Variant
59    Dim lngMatchCount As Long
60
61    For Each varItem1 In Array1
62        For Each varItem2 In Array2
63            If StrComp(varItem1, varItem2, vbBinaryCompare) = 0 Then
64                ReDim Preserve varNewArray(0 To lngMatchCount)
65                varNewArray(lngMatchCount) = varItem1
66                lngMatchCount = lngMatchCount + 1
67            End If
68        Next
69    Next
70
71    IntersectionArray = varNewArray
72
73End Function
74
75'2つの1次元配列のうち、Array1 にあって Array2 にない要素のみで構成された配列を返す関数
76Function DifferenceArray(Array1() As Variant, Array2() As Variant) As Variant()
77
78    Dim varNewArray() As Variant
79    Dim varItem1 As Variant
80    Dim varItem2 As Variant
81    Dim blMatched As Boolean
82    Dim lngUnmatchCount As Long
83
84    For Each varItem1 In Array1
85        blMatched = False
86        For Each varItem2 In Array2
87            If StrComp(varItem1, varItem2, vbBinaryCompare) = 0 Then
88                blMatched = True
89                Exit For
90            End If
91        Next
92        If blMatched = False Then
93            ReDim Preserve varNewArray(0 To lngUnmatchCount)
94            varNewArray(lngUnmatchCount) = varItem1
95            lngUnmatchCount = lngUnmatchCount + 1
96        End If
97    Next
98
99    DifferenceArray = varNewArray
100
101End Function
102
103'2つの1次元配列 Array1 と Array2 の全ての要素を含む配列を返す関数
104Function UnionArray(Array1() As Variant, Array2() As Variant) As Variant()
105
106    Dim varNewArray() As Variant
107    Dim varItem As Variant
108    Dim lngItemCount As Long
109
110    For Each varItem In Array1
111        ReDim Preserve varNewArray(0 To lngItemCount)
112        varNewArray(lngItemCount) = varItem
113        lngItemCount = lngItemCount + 1
114    Next
115
116    For Each varItem In Array2
117        ReDim Preserve varNewArray(0 To lngItemCount)
118        varNewArray(lngItemCount) = varItem
119        lngItemCount = lngItemCount + 1
120    Next
121
122    UnionArray = varNewArray
123
124End Function