回答編集履歴

5

コード修正

2017/05/01 23:08

投稿

hatena19
hatena19

スコア33715

test CHANGED
@@ -58,7 +58,7 @@
58
58
 
59
59
  Dim i As Long
60
60
 
61
- Dim ary1
61
+ Dim ary1()
62
62
 
63
63
  Dim ary2() '動的配列として宣言
64
64
 
@@ -80,7 +80,7 @@
80
80
 
81
81
  maxrow = .Cells(Rows.Count, 1).End(xlUp).Row
82
82
 
83
- ary1 = .Range(.Cells(2, 1), .Cells(maxrow, 3))
83
+ ary1 = .Range(.Cells(2, 1), .Cells(maxrow, 3)).Value
84
84
 
85
85
  For i = UBound(ary1) To LBound(ary1) Step -1
86
86
 
@@ -100,7 +100,7 @@
100
100
 
101
101
  Erase ary1 '配列の初期化
102
102
 
103
- ary1 = .Range(.Cells(2, 1), .Cells(maxrow, 2))
103
+ ary1 = .Range(.Cells(2, 1), .Cells(maxrow, 2)).Value
104
104
 
105
105
  For i = LBound(ary1) To UBound(ary1)
106
106
 
@@ -108,7 +108,7 @@
108
108
 
109
109
  Next
110
110
 
111
- .Range(.Cells(2, 3), .Cells(maxrow, 3)) = ary2
111
+ .Range(.Cells(2, 3), .Cells(maxrow, 3)).Value = ary2
112
112
 
113
113
  End With
114
114
 

4

追記

2017/05/01 23:08

投稿

hatena19
hatena19

スコア33715

test CHANGED
@@ -17,6 +17,24 @@
17
17
  は、私のサンプルが参照するセルが数値だったので、`Long` にしましたが、
18
18
 
19
19
  文字列だったら、`String` にするなどそちらのデータ型にあわせてくださいね。
20
+
21
+
22
+
23
+ 動作検証
24
+
25
+ ---
26
+
27
+ 質問のコード、さらに下記のチューンナップコード、
28
+
29
+ どちらでも下図のように想定の結果となりました。
30
+
31
+
32
+
33
+ ![イメージ説明](55b62ac15d1ace3ad8879c42ca57fa42.png)
34
+
35
+
36
+
37
+ ダミーのデータでなく、実際に想定外の結果になるデータを提示できませんか。
20
38
 
21
39
 
22
40
 

3

コードの修正

2017/05/01 10:43

投稿

hatena19
hatena19

スコア33715

test CHANGED
@@ -58,9 +58,7 @@
58
58
 
59
59
 
60
60
 
61
- sw.SWStart
62
-
63
- With Sheets("条件")
61
+ With Sheets("条件")
64
62
 
65
63
  maxrow = .Cells(Rows.Count, 1).End(xlUp).Row
66
64
 
@@ -74,21 +72,13 @@
74
72
 
75
73
  End With
76
74
 
77
- sw.SWStop
75
+
78
-
79
- sw.SWShow
80
-
81
-
82
-
83
- sw.SWStart
84
76
 
85
77
  With Sheets("抽出結果")
86
78
 
87
79
  maxrow = .Cells(Rows.Count, 1).End(xlUp).Row
88
80
 
89
- ReDim ary2(2 To maxrow, 0) '動的配列のサイズを宣言
81
+ ReDim ary2(2 To maxrow, 0) '動的配列のサイズを宣言
90
-
91
-
92
82
 
93
83
  Erase ary1 '配列の初期化
94
84
 
@@ -104,15 +94,9 @@
104
94
 
105
95
  End With
106
96
 
107
- sw.SWStop
97
+
108
-
109
- sw.SWShow
110
-
111
-
112
98
 
113
99
  Set mydic = Nothing
114
-
115
-
116
100
 
117
101
  Application.EnableEvents = True
118
102
 

2

追記

2017/05/01 08:24

投稿

hatena19
hatena19

スコア33715

test CHANGED
@@ -17,3 +17,107 @@
17
17
  は、私のサンプルが参照するセルが数値だったので、`Long` にしましたが、
18
18
 
19
19
  文字列だったら、`String` にするなどそちらのデータ型にあわせてくださいね。
20
+
21
+
22
+
23
+ さらにチューンナップ
24
+
25
+ ---
26
+
27
+ コードを見直してみたら、"抽出結果"シートでセル毎に読み込みしていたので、それも 配列 に一気に読み込むようにしてみました。これで、前回よりさらに倍以上高速化できました。
28
+
29
+
30
+
31
+ あと、参照結果の書き込み用の配列も動的配列にして、配列のサイズをデータ数に合わせて、無駄にメモリを使用しないようにしました。
32
+
33
+
34
+
35
+ ```
36
+
37
+ Public Sub dic_04_4()
38
+
39
+ Dim mydic As Object
40
+
41
+ Dim i As Long
42
+
43
+ Dim ary1
44
+
45
+ Dim ary2() '動的配列として宣言
46
+
47
+ Dim maxrow As Long
48
+
49
+
50
+
51
+ Application.ScreenUpdating = False
52
+
53
+ Application.EnableEvents = False
54
+
55
+
56
+
57
+ Set mydic = CreateObject("Scripting.Dictionary")
58
+
59
+
60
+
61
+ sw.SWStart
62
+
63
+ With Sheets("条件")
64
+
65
+ maxrow = .Cells(Rows.Count, 1).End(xlUp).Row
66
+
67
+ ary1 = .Range(.Cells(2, 1), .Cells(maxrow, 3))
68
+
69
+ For i = UBound(ary1) To LBound(ary1) Step -1
70
+
71
+ mydic(ary1(i, 1) & "," & ary1(i, 2)) = ary1(i, 3)
72
+
73
+ Next i
74
+
75
+ End With
76
+
77
+ sw.SWStop
78
+
79
+ sw.SWShow
80
+
81
+
82
+
83
+ sw.SWStart
84
+
85
+ With Sheets("抽出結果")
86
+
87
+ maxrow = .Cells(Rows.Count, 1).End(xlUp).Row
88
+
89
+ ReDim ary2(2 To maxrow, 0) '動的配列のサイズを宣言
90
+
91
+
92
+
93
+ Erase ary1 '配列の初期化
94
+
95
+ ary1 = .Range(.Cells(2, 1), .Cells(maxrow, 2))
96
+
97
+ For i = LBound(ary1) To UBound(ary1)
98
+
99
+ ary2(i + 1, 0) = mydic.Item(ary1(i, 1) & "," & ary1(i, 2))
100
+
101
+ Next
102
+
103
+ .Range(.Cells(2, 3), .Cells(maxrow, 3)) = ary2
104
+
105
+ End With
106
+
107
+ sw.SWStop
108
+
109
+ sw.SWShow
110
+
111
+
112
+
113
+ Set mydic = Nothing
114
+
115
+
116
+
117
+ Application.EnableEvents = True
118
+
119
+ Application.ScreenUpdating = True
120
+
121
+ End Sub
122
+
123
+ ```

1

書式の改善

2017/05/01 08:20

投稿

hatena19
hatena19

スコア33715

test CHANGED
@@ -12,8 +12,8 @@
12
12
 
13
13
  ちなみに、
14
14
 
15
- Dim ary2(2 To 180000, 0) As Long
15
+ `Dim ary2(2 To 180000, 0) As Long`
16
16
 
17
- は、私のサンプルが参照するセルが数値だったので、Longにしましたが、
17
+ は、私のサンプルが参照するセルが数値だったので、`Long` にしましたが、
18
18
 
19
- 文字列だったら、Stringにするなどそちらのデータ型にあわせてくださいね。
19
+ 文字列だったら、`String` にするなどそちらのデータ型にあわせてくださいね。