回答編集履歴

4

追記

2021/04/25 05:36

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -96,7 +96,7 @@
96
96
 
97
97
  ```ここに言語を入力
98
98
 
99
- Sub test()
99
+ Sub test2()
100
100
 
101
101
  Dim Range1 As Range, Range2 As Range
102
102
 
@@ -139,3 +139,87 @@
139
139
 
140
140
 
141
141
  ```
142
+
143
+ ---
144
+
145
+ また、こちらは連想配列を使った例です。
146
+
147
+
148
+
149
+ ```VBA
150
+
151
+ Sub test3()
152
+
153
+ '変数Range1 にはsheet1のA1:A30000がRange型として入ってます。
154
+
155
+ '変数Range2 にはsheet2のA1:A30000がRange型として入ってます。
156
+
157
+ Dim Range1 As Range, Range2 As Range
158
+
159
+ Set Range1 = Sheet1.Range("A1:A30000")
160
+
161
+ Set Range2 = Sheet2.Range("A1:A30000")
162
+
163
+
164
+
165
+ 'データレンジ取得し配列へ代入
166
+
167
+ Dim arr1 As Variant '
168
+
169
+ Dim arr2 As Variant '仮納品データレンジ用配列
170
+
171
+ arr1 = Range1
172
+
173
+ arr2 = Range2
174
+
175
+
176
+
177
+ 'カウント
178
+
179
+ Dim rep() As Integer 'カウント結果代入用の配列変数を用意
180
+
181
+ ReDim rep(1 To Range1.Count, 1 To 1)
182
+
183
+
184
+
185
+
186
+
187
+ 'カウント
188
+
189
+ Dim tmp As Variant
190
+
191
+ Dim i As Long
192
+
193
+ Dim j As Long
194
+
195
+ Dim d
196
+
197
+ Set d = CreateObject("Scripting.Dictionary")
198
+
199
+ For j = 1 To UBound(arr2, 1)
200
+
201
+ d(arr2(j, 1)) = d(arr2(j, 1)) + 1
202
+
203
+ Next
204
+
205
+
206
+
207
+ For i = 1 To UBound(arr1, 1)
208
+
209
+ If d.Exists(arr1(i, 1)) Then
210
+
211
+ rep(i, 1) = d(arr1(i, 1))
212
+
213
+ End If
214
+
215
+ Next i
216
+
217
+ 'カウント結果をセルへ貼付
218
+
219
+ Range1.Offset(0, 1) = rep
220
+
221
+
222
+
223
+ End Sub
224
+
225
+ ```

3

追記

2021/04/25 05:35

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -81,3 +81,61 @@
81
81
 
82
82
 
83
83
  ```
84
+
85
+ ---
86
+
87
+ <追記>
88
+
89
+ 上記のように配列に代入しても、大量データ同志の二重ループだとどうしても遅くなります。
90
+
91
+ また、やりたいことによっては、必ずしも配列にするのが正解とも限らないと思います。
92
+
93
+ たとえば、以下はワークシート関数を利用してみたものです。
94
+
95
+
96
+
97
+ ```ここに言語を入力
98
+
99
+ Sub test()
100
+
101
+ Dim Range1 As Range, Range2 As Range
102
+
103
+ Set Range1 = Sheet1.Range("A1:A30000")
104
+
105
+ Set Range2 = Sheet2.Range("A1:A30000")
106
+
107
+
108
+
109
+ Dim rep()
110
+
111
+ ReDim rep(1 To Range1.Count, 1 To 2)
112
+
113
+
114
+
115
+ Dim i As Long
116
+
117
+ For i = 1 To Range1.Count
118
+
119
+
120
+
121
+ rep(i, 1) = WorksheetFunction.CountIf(Range2, Range1(i, 1)) 'Sheet2でのカウント結果
122
+
123
+ If rep(i, 1) > 0 Then
124
+
125
+ rep(i, 2) = WorksheetFunction.Match(Range1(i, 1), Range2, False) 'Sheet2の(最初にマッチした)行番号
126
+
127
+ End If
128
+
129
+ Next i
130
+
131
+
132
+
133
+ Range1.Offset(0, 1).Resize(, 2) = rep
134
+
135
+
136
+
137
+ End Sub
138
+
139
+
140
+
141
+ ```

2

修正

2021/04/25 05:15

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -34,7 +34,7 @@
34
34
 
35
35
  Dim rep() As Integer 'カウント結果代入用の配列変数を用意
36
36
 
37
- ReDim rep(1 To Range1.Count)
37
+ ReDim rep(1 To Range1.Count, 1 To 1)
38
38
 
39
39
 
40
40
 
@@ -50,15 +50,17 @@
50
50
 
51
51
  Dim cnt As Integer 'カウント
52
52
 
53
- For i = 1 To Range1.Count
53
+ For i = 1 To Ubound(arr1, 1)
54
54
 
55
- For j = 1 To Range2.Count
55
+ For j = 1 To Ubound(arr2, 1)
56
56
 
57
57
  If arr1(i, 1) = arr2(j, 1) Then
58
58
 
59
59
  cnt = cnt + 1
60
60
 
61
61
  End If
62
+
63
+ DoEvents
62
64
 
63
65
  Next j
64
66
 

1

追記

2021/04/25 05:03

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -4,25 +4,77 @@
4
4
 
5
5
  ```VBA
6
6
 
7
- 'Set arr1 = Range1
7
+ Sub test()
8
8
 
9
- 'Set arr2 = Range2
9
+ '変数Range1 にはsheet1のA1:A30000がRange型として入ってます。
10
10
 
11
- arr1 = Range1
11
+ '変数Range2 にはsheet2のA1:A30000がRange型として入ってます。
12
12
 
13
+ Dim Range1 As Range, Range2 As Range
14
+
15
+ Set Range1 = Sheet1.Range("A1:A30000")
16
+
17
+ Set Range2 = Sheet2.Range("A1:A30000")
18
+
19
+
20
+
21
+ 'データレンジ取得し配列へ代入
22
+
23
+ Dim arr1 As Variant '
24
+
25
+ Dim arr2 As Variant '仮納品データレンジ用配列
26
+
27
+ arr1 = Range1
28
+
13
- arr2 = Range2
29
+ arr2 = Range2
30
+
31
+
32
+
33
+ 'カウント
34
+
35
+ Dim rep() As Integer 'カウント結果代入用の配列変数を用意
36
+
37
+ ReDim rep(1 To Range1.Count)
38
+
39
+
40
+
41
+
42
+
43
+ 'カウント
44
+
45
+ Dim tmp As Variant
46
+
47
+ Dim i As Long
48
+
49
+ Dim j As Long
50
+
51
+ Dim cnt As Integer 'カウント
52
+
53
+ For i = 1 To Range1.Count
54
+
55
+ For j = 1 To Range2.Count
56
+
57
+ If arr1(i, 1) = arr2(j, 1) Then
58
+
59
+ cnt = cnt + 1
60
+
61
+ End If
62
+
63
+ Next j
64
+
65
+ rep(i) = cnt
66
+
67
+ cnt = 0
68
+
69
+ Next i
70
+
71
+ 'カウント結果をセルへ貼付
72
+
73
+ Range1.Offset(0, 1) = rep
14
74
 
15
75
 
16
76
 
17
- 'ReDim rep(arr1.Count)
18
-
19
- ReDim rep(Range1.Count)
77
+ End Sub
20
-
21
-
22
-
23
- 'If arr1(i) = arr2(j) Then
24
-
25
- If arr1(i, 1) = arr2(j, 1) Then
26
78
 
27
79
 
28
80