質問するログイン新規登録

回答編集履歴

3

説明追記

2021/10/22 12:53

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -35,4 +35,5 @@
35
35
  ```
36
36
 
37
37
  100万×20万のサンプルデータを作成して上記のコードを実行してみたら、数十分たっても終わらないです。
38
- これだけのループになるとさすがに配列でも苦しいですね。
38
+ これだけのループになるとさすがに配列でも苦しいですね。
39
+ 1万×1万のデータで9秒ぐらいでした。

2

説明追記

2021/10/22 12:53

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -32,4 +32,7 @@
32
32
 
33
33
  Cells(1, 3).Resize(ACnt).Value = C
34
34
  End Sub
35
- ```
35
+ ```
36
+
37
+ 100万×20万のサンプルデータを作成して上記のコードを実行してみたら、数十分たっても終わらないです。
38
+ これだけのループになるとさすがに配列でも苦しいですね。

1

コード追記

2021/10/22 12:22

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -1,4 +1,35 @@
1
1
  A列とB列をそれぞれ配列に入れて、2重ループで部分一致を検索する。
2
2
  結果も配列に出力して、最後に結果配列をシートに出力ということになると思います。
3
3
 
4
- エクセルで遅くなる原因はセルへの参照、更新ですので、それをなるべく少なくするという方針でいくのがいいでしょう。
4
+ エクセルで遅くなる原因はセルへの参照、更新ですので、それをなるべく少なくするという方針でいくのがいいでしょう。
5
+
6
+
7
+ ```vba
8
+ Public Sub Sample()
9
+ Dim A(), B(), C() As String
10
+ Dim ACnt As Long, BCnt As Long
11
+ ACnt = Cells(Rows.Count, 1).End(xlUp).Row
12
+ A = Cells(1, 1).Resize(ACnt).Value
13
+ BCnt = Cells(Rows.Count, 2).End(xlUp).Row
14
+ B = Cells(1, 2).Resize(BCnt).Value
15
+ ReDim C(1 To ACnt, 1 To 1)
16
+
17
+ Dim i As Long, j As Long
18
+ For i = 1 To ACnt
19
+ For j = 1 To BCnt
20
+ If InStr(1, B(j, 1), A(i, 1), vbBinaryCompare) > 0 Then
21
+ C(i, 1) = C(i, 1) & "," & B(j, 1)
22
+ End If
23
+ Next
24
+ Next
25
+ For i = 1 To ACnt
26
+ If C(i, 1) = "" Then
27
+ C(i, 1) = "NA"
28
+ Else
29
+ C(i, 1) = Mid(C(i, 1), 2)
30
+ End If
31
+ Next
32
+
33
+ Cells(1, 3).Resize(ACnt).Value = C
34
+ End Sub
35
+ ```