回答編集履歴

2

コード修正

2022/09/15 08:54

投稿

hatena19
hatena19

スコア33763

test CHANGED
@@ -3,12 +3,12 @@
3
3
 
4
4
  ```vba
5
5
  Worksheets("データベース").Cells(i, "B").Resize(, 17).Copy
6
- .Cells(N + 1, "C") .PasteSpecial Paste:=xlPasteValues
6
+ .Cells(N + 1, "C").PasteSpecial Paste:=xlPasteValues
7
7
  ```
8
8
  あるいは、Value への代入の方が少し高速です。
9
9
 
10
10
  ```vba
11
- .Cells(N + 1, "C").Resize(, 17) .Value = Worksheets("データベース").Cells(i, "B").Resize(, 17).Value
11
+ .Cells(N + 1, "C").Resize(, 17).Value = Worksheets("データベース").Cells(i, "B").Resize(, 17).Value
12
12
  ```
13
13
 
14
14
  ただ、ループで1行ずつ転記していくより、オートフィルターで抽出して1回でコピーした方が高速だと思いますが、遅かったですか。

1

コード追記

2022/09/15 00:36

投稿

hatena19
hatena19

スコア33763

test CHANGED
@@ -15,4 +15,22 @@
15
15
 
16
16
  あと、高速化の定番の画面更新の停止、再計算の停止は試してみましたか。
17
17
 
18
+ ---
19
+ オートフィルターを使ったコード例ですが、下記で遅いですか。
18
20
 
21
+ ```vba
22
+ Sub TEST2()
23
+ Application.ScreenUpdating = False
24
+ Application.Calculation = xlCalculationManual
25
+
26
+ With Worksheets("データベース").Range("B6:R5006")
27
+ .AutoFilter Field:=1, Criteria1:="キャップ"
28
+ .Offset(1).Copy
29
+ End With
30
+
31
+ Worksheets("貼付先").Cells(Rows.Count, "C").End(xlUp).Offset(1).PasteSpecial xlPasteValues
32
+
33
+ Application.ScreenUpdating = True
34
+ Application.Calculation = xlCalculationAutomatic
35
+ End Sub
36
+ ```