回答編集履歴

3

説明追記

2021/10/22 12:53

投稿

hatena19
hatena19

スコア33934

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

2

説明追記

2021/10/22 12:53

投稿

hatena19
hatena19

スコア33934

test CHANGED
@@ -67,3 +67,9 @@
67
67
  End Sub
68
68
 
69
69
  ```
70
+
71
+
72
+
73
+ 100万×20万のサンプルデータを作成して上記のコードを実行してみたら、数十分たっても終わらないです。
74
+
75
+ これだけのループになるとさすがに配列でも苦しいですね。

1

コード追記

2021/10/22 12:22

投稿

hatena19
hatena19

スコア33934

test CHANGED
@@ -5,3 +5,65 @@
5
5
 
6
6
 
7
7
  エクセルで遅くなる原因はセルへの参照、更新ですので、それをなるべく少なくするという方針でいくのがいいでしょう。
8
+
9
+
10
+
11
+
12
+
13
+ ```vba
14
+
15
+ Public Sub Sample()
16
+
17
+ Dim A(), B(), C() As String
18
+
19
+ Dim ACnt As Long, BCnt As Long
20
+
21
+ ACnt = Cells(Rows.Count, 1).End(xlUp).Row
22
+
23
+ A = Cells(1, 1).Resize(ACnt).Value
24
+
25
+ BCnt = Cells(Rows.Count, 2).End(xlUp).Row
26
+
27
+ B = Cells(1, 2).Resize(BCnt).Value
28
+
29
+ ReDim C(1 To ACnt, 1 To 1)
30
+
31
+
32
+
33
+ Dim i As Long, j As Long
34
+
35
+ For i = 1 To ACnt
36
+
37
+ For j = 1 To BCnt
38
+
39
+ If InStr(1, B(j, 1), A(i, 1), vbBinaryCompare) > 0 Then
40
+
41
+ C(i, 1) = C(i, 1) & "," & B(j, 1)
42
+
43
+ End If
44
+
45
+ Next
46
+
47
+ Next
48
+
49
+ For i = 1 To ACnt
50
+
51
+ If C(i, 1) = "" Then
52
+
53
+ C(i, 1) = "NA"
54
+
55
+ Else
56
+
57
+ C(i, 1) = Mid(C(i, 1), 2)
58
+
59
+ End If
60
+
61
+ Next
62
+
63
+
64
+
65
+ Cells(1, 3).Resize(ACnt).Value = C
66
+
67
+ End Sub
68
+
69
+ ```