回答編集履歴

6

質問の追記に合わせて、内容を変更

2019/06/01 11:46

投稿

hatena19
hatena19

スコア33699

test CHANGED
@@ -78,15 +78,15 @@
78
78
 
79
79
  ```vba
80
80
 
81
- ThisWorkbook.Sheets("検索").Range("A" & k).Resize(2,5).Value _
81
+ ThisWorkbook.Sheets("検索").Range("A" & k).Resize(2,23).Value _
82
82
 
83
- = tmpSheet.Range("A" & i).Resize(2,5).Value
83
+ = tmpSheet.Range("A" & i).Resize(2,23).Value
84
84
 
85
85
  ```
86
86
 
87
+ アップされた画像をみるとひとつのデータ範囲は、2行×23列のようですので、それに合わせて変更しました。
87
88
 
88
89
 
89
- データ範囲が不明なので、Resize の部分は実際のデータ範囲にあわせて変更してください。
90
90
 
91
91
 
92
92
 

5

追記3

2019/06/01 11:45

投稿

hatena19
hatena19

スコア33699

test CHANGED
@@ -18,7 +18,7 @@
18
18
 
19
19
 
20
20
 
21
- 追記
21
+ 追記1
22
22
 
23
23
  ---
24
24
 
@@ -87,3 +87,91 @@
87
87
 
88
88
 
89
89
  データ範囲が不明なので、Resize の部分は実際のデータ範囲にあわせて変更してください。
90
+
91
+
92
+
93
+ 追記3
94
+
95
+ ---
96
+
97
+ 追記1 の後者の配列を使う場合のロジックのコード例
98
+
99
+
100
+
101
+ 検索範囲固定、キーワード固定、検索列1行目 のシンプルなモデルでのコード例ですので、
102
+
103
+ ロジックを理解して、実際のものに応用してください。
104
+
105
+
106
+
107
+ ```vba
108
+
109
+ Public Sub test()
110
+
111
+ Dim f() As Variant
112
+
113
+ f = Worksheets(1).Range("A1").Resize(100, 5).Value '検索範囲を配列に格納
114
+
115
+
116
+
117
+ Dim r() As Variant
118
+
119
+ ReDim r(1 To UBound(f), 1 To UBound(f, 2)) '検索結果格納用配列
120
+
121
+
122
+
123
+
124
+
125
+ Dim KeyWord As String
126
+
127
+ KeyWord = "xxx" '検索キーワード
128
+
129
+
130
+
131
+ Dim i As Long, rcnt As Long, j As Long
132
+
133
+ rcnt = 0
134
+
135
+
136
+
137
+ For i = 1 To UBound(f) Step 2
138
+
139
+ If InStr(f(i, 1), KeyWord) > 0 Then '部分一致したら
140
+
141
+ '検索結果配列に格納
142
+
143
+ For j = 0 To 1 '2行分
144
+
145
+ rcnt = rcnt + 1
146
+
147
+ r(rcnt, 1) = f(i + j, 1)
148
+
149
+ r(rcnt, 2) = f(i + j, 2)
150
+
151
+ r(rcnt, 3) = f(i + j, 3)
152
+
153
+ r(rcnt, 4) = f(i + j, 4)
154
+
155
+ r(rcnt, 5) = f(i + j, 5)
156
+
157
+ Next
158
+
159
+ End If
160
+
161
+ Next
162
+
163
+
164
+
165
+ Worksheets(2).Range("A1").Resize(rcnt, 5).Value = r '検索結果配列をセル範囲に代入
166
+
167
+
168
+
169
+ End Sub
170
+
171
+ ```
172
+
173
+
174
+
175
+ 処理のネックとなるセルへのアクセスは、検索範囲を配列に格納と、検索結果配列の代入の2回だけで、
176
+
177
+ あとは、メモリ上の操作になりますので、高速化します。

4

コード修正

2019/05/31 05:44

投稿

hatena19
hatena19

スコア33699

test CHANGED
@@ -78,7 +78,7 @@
78
78
 
79
79
  ```vba
80
80
 
81
- ThisWorkbook.Sheets("検索").Rows("A" & k).Resize(2,5).Value _
81
+ ThisWorkbook.Sheets("検索").Range("A" & k).Resize(2,5).Value _
82
82
 
83
83
  = tmpSheet.Range("A" & i).Resize(2,5).Value
84
84
 

3

書式の改善

2019/05/31 04:13

投稿

hatena19
hatena19

スコア33699

test CHANGED
@@ -76,7 +76,13 @@
76
76
 
77
77
 
78
78
 
79
+ ```vba
80
+
79
- ThisWorkbook.Sheets("検索").Rows("A" & k).Resize(2,5).Value = tmpSheet.Range("A" & i).Resize(2,5).Value
81
+ ThisWorkbook.Sheets("検索").Rows("A" & k).Resize(2,5).Value _
82
+
83
+ = tmpSheet.Range("A" & i).Resize(2,5).Value
84
+
85
+ ```
80
86
 
81
87
 
82
88
 

2

追記2

2019/05/31 01:50

投稿

hatena19
hatena19

スコア33699

test CHANGED
@@ -57,3 +57,27 @@
57
57
  0. 配列をループして条件に一致する行と次の行を結果配列に追加していく。
58
58
 
59
59
  0. 結果配列をレンジに代入する。
60
+
61
+
62
+
63
+ 追記2
64
+
65
+ ---
66
+
67
+ > 実際、#####で囲んだ部分をコメントアウトして実行すると処理速度が劇的に速くなります。
68
+
69
+ > (通常は40秒かかり、#######で囲んだ部分をコメントアウトして実行した場合は、5秒で処理が終了)
70
+
71
+
72
+
73
+ 質問に上記が追記れさているのに気が付きました。
74
+
75
+ コピーが値だけでいいなら(書式は無視)、Value の代入にすると改善されるかも。
76
+
77
+
78
+
79
+ ThisWorkbook.Sheets("検索").Rows("A" & k).Resize(2,5).Value = tmpSheet.Range("A" & i).Resize(2,5).Value
80
+
81
+
82
+
83
+ データ範囲が不明なので、Resize の部分は実際のデータ範囲にあわせて変更してください。

1

追記

2019/05/31 01:46

投稿

hatena19
hatena19

スコア33699

test CHANGED
@@ -15,3 +15,45 @@
15
15
  Findはやめて、AutoFilter で絞り込んだ結果をコピーするというロジックに書きなおすと、
16
16
 
17
17
  かなり改善できると思います。
18
+
19
+
20
+
21
+ 追記
22
+
23
+ ---
24
+
25
+ 2行で1項目ということなので、AutoFilter を使うなら、作業列を使う方法になるかな。
26
+
27
+
28
+
29
+ 0. 作業列の奇数行に、条件に一致するなら、〇 を出力する式を設定。
30
+
31
+ 0. 偶数行は、上の列を参照する式にする。
32
+
33
+ 0. AutoFilter で作業列の〇の行を絞り込む。
34
+
35
+ 0. これの作業列を除いた列をコピーする。
36
+
37
+ 0. 作業列をクリアする。
38
+
39
+
40
+
41
+ これで、コピーは1回ですむのでかなり高速化はできると思います。
42
+
43
+
44
+
45
+ 配列を使う場合は、
46
+
47
+ セルをひとつづつ参照するのが時間がかかるので、セルへのアクセスをなるべく減らす。
48
+
49
+ 配列上で処理をして、結果を一気にレンジに代入する。
50
+
51
+ という方針で作成すると高速化できます。
52
+
53
+
54
+
55
+ 0. 検索対象範囲を一気に配列に格納する。
56
+
57
+ 0. 配列をループして条件に一致する行と次の行を結果配列に追加していく。
58
+
59
+ 0. 結果配列をレンジに代入する。