回答編集履歴

3

コードの修正、コードの追記

2017/05/21 16:55

投稿

hatena19
hatena19

スコア33757

test CHANGED
@@ -74,9 +74,7 @@
74
74
 
75
75
  If c.Value <> searchWord Then
76
76
 
77
- Cells(i, 1).Offset(0, _
78
-
79
- Cells(i, Columns.Count).End(xlToLeft).Column) _
77
+ Cells(i, Cells(i, Columns.Count).End(xlToLeft).Column + 1) _
80
78
 
81
79
  = c.Value
82
80
 
@@ -98,6 +96,72 @@
98
96
 
99
97
  ```
100
98
 
99
+ 追記
100
+
101
+ ---
102
+
103
+
104
+
101
105
 
102
106
 
103
107
  ただしFindメソッドは遅いので、データ数が多い場合は、検索対象範囲を配列に入れて、 `For Next`でループしながら、Like演算子で部分一致比較をすると高速になります。
108
+
109
+
110
+
111
+ ```
112
+
113
+ Public Sub ArrayLikeTest()
114
+
115
+ Dim aryA() As Variant
116
+
117
+ Dim aryMatch() As Variant, c As Long
118
+
119
+ Dim searchWord As String
120
+
121
+ Dim i As Long, j As Long
122
+
123
+
124
+
125
+ aryA = UsedRange.Columns(1).Value 'A列を配列に
126
+
127
+ For i = 1 To UBound(aryA)
128
+
129
+ searchWord = aryA(i, 1)
130
+
131
+ c = -1
132
+
133
+ For j = 1 To UBound(aryA)
134
+
135
+ If i <> j Then
136
+
137
+ If aryA(j, 1) Like "*" & searchWord & "*" Then '部分一致比較
138
+
139
+ c = c + 1
140
+
141
+ ReDim Preserve aryMatch(c)
142
+
143
+ aryMatch(c) = aryA(j, 1) '検索結果を配列に格納
144
+
145
+ End If
146
+
147
+ End If
148
+
149
+ Next j
150
+
151
+ If c >= 0 Then
152
+
153
+ Range(Cells(i, 2), Cells(i, c + 2)).Value = aryMatch
154
+
155
+ End If
156
+
157
+ ReDim aryMatch(0) '配列を初期化
158
+
159
+ Next i
160
+
161
+
162
+
163
+ End Sub
164
+
165
+
166
+
167
+ ```

2

説明の追記

2017/05/21 16:55

投稿

hatena19
hatena19

スコア33757

test CHANGED
@@ -12,7 +12,7 @@
12
12
 
13
13
 
14
14
 
15
- `Find`メソッドの引数で、`LookAt:=xlPart`とすれば部分一致になります。
15
+ `Find`メソッドの引数で、`LookAt:=xlPart`とすれば部分一致になります。検索対象に検索値が部分一致するいう意味ですので、検索値より短い単語は引っ掛かりません。これで、検索対象の方が長いというのは保証されます。
16
16
 
17
17
 
18
18
 

1

説明の追記

2017/05/21 14:06

投稿

hatena19
hatena19

スコア33757

test CHANGED
@@ -26,7 +26,7 @@
26
26
 
27
27
 
28
28
 
29
- 上記を考慮して、
29
+ 上記を考慮して、サンプルコードを作成してみました。
30
30
 
31
31
  データの入力してあるシートのモジュールに下記のコードを記述してください。
32
32