vbaで自動的に牽引？を保存していたりしますか？

お疲れ様です。
Takkoです。

現在、VBAでツール開発をしています。

単純なプログラムで、
B6～BXXXXに日付がユーザの入力したデータ分あり、
C6～CXXXXにも同様に日付のデータが存在していて、
B3,C4に入力されている単一の日付と、
B6,C6以降の処理をForでセル行数を回して日付の大小比較をし結果を
E6～EXXXXセル、F6～FXXXXセルに格納していくというプログラムがあります。

例
B3セル　2016/07/01
C3セル 2016/08/01

B6 2016/06/31
B7 2016/06/31
B8 2016/06/31
B9 2016/07/01
B10 2016/07/04
B11 2016/07/05
///
BXXXX 2016/08/02

C3の列もBのセル同様で、
B列のデータ分だけC列のデータが存在する。（行数が同じ）

で、
B3とB6～BXXXXを比較し、結果をE6～EXXXXに格納、
C3とC6～CXXXXを比較し、結果をF6～FXXXXに格納するという処理です。

ここで、Debug.Print Time()を使用し、
処理時間の計測をしたのですが、下記のような結果になりました。

--ややこしくなってしまったため、結果を完結にしました。

①9回の平均を求めました。
1440件 9回分実行速度AVG 8.555555556
2880件 9回分実行速度AVG 12.22222222
5760件 9回分実行速度AVG 20.44444444

②また、それぞれの9回で処理実行速度が大きく推移していることはなく、
5760件の時では
20 20 21 20 21 20 21 21 20 (s)
と平均からブレることは無かったです。

①からデータ件数が倍になっても処理速度は1.5倍ずつしか上がらないことがわかり、
②から一回一回の処理実行速度からはpoolなどの処理高速化はされていないようでした。

この①と②は矛盾しているような気がします。

理由
②の高速化が行われていないなら、データ件数が二倍になったら、処理即度も二倍になるはずです。

この現象はどういう状況で起こっているのですか。

よろしくお願いします。

vba
1 'セルにセットする文字列を格納した定数
2    Const C_START_FIRST As String = "先行着手"
3    Const C_START As String = "着手"
4    Const C_START_LATE As String = "遅れ"
5    Const C_START_EMP As String = ""
6    
7    Const C_END_FIRST As String = "先行完了"
8    Const C_END As String = "完了"
9    Const C_END_LATE As String = "遅れ"
10    Const C_END_EMP As String = ""
11    
12    
13    'ColorIndex用の色識別定数
14    Const C_BLACK As Integer = 1
15    Const C_RED As Integer = 3
16    Const C_ORANGE As Integer = 45
17    Const C_GREEN As Integer = 4
18    
19    
20    'データ行数を格納する変数。
21    Dim rowsCount As Integer
22    
23    'セル内のデータを格納する変数。
24    Dim cellDateFrom As Date
25    Dim cellDateTo As Date
26    Dim cellDateB As Variant
27    Dim cellDateC As Variant
28    Dim cellDataD As Integer
29
30Sub 実行()
31        Debug.Print Time()
32        Call SetReportDate
33        Call SetRows
34        Call EditFormats
35        Call SetCells
36        Range("A1").Select
37        Debug.Print Time()
38        MsgBox ("処理が正常に完了しました。")
39End Sub
40
41'報告期間FROMと報告期間TOを取得する。
42    Sub SetReportDate()
43        cellDateFrom = Cells(3, 2).Value
44        cellDateTo = Cells(3, 3).Value
45        If cellDateFrom = "0:00:00" Or cellDateTo = "0:00:00" Or cellDateFrom = Empty Or cellDateTo = Empty Then
46            MsgBox ("報告期間FROMまたは報告期間TOが入力されていません。")
47            End
48        End If
49    End Sub
50    
51    'ユーザが入力したデータの行数をrowsCountにセットする。
52    Sub SetRows()
53        Range("B6").Select
54        If Range("B6").Value = Empty Then
55            MsgBox ("作業着手予定日が入力されていないか、行頭から入力されていません。")
56            End
57        Else
58            Range(Selection, Selection.End(xlDown)).Select
59            rowsCount = Selection.rows.count + 5
60        End If
61    End Sub
62    
63    '変換対象列引数として、EditFormatに渡す。
64    Sub EditFormats()
65        Call EditFormat(2)
66        Call EditFormat(3)
67    End Sub
68    
69    '"16/09/26(火)"形式の入力を"2016/09/26"形式に整える。
70    Sub EditFormat(pClumn As Integer)
71        'フォーマット変更時に使用する変数
72        Dim inStrVal As Integer
73        Dim afterCellVal As String
74        '変換対象列の6行目から最終行までを変換する。
75        For pRow = 6 To rowsCount
76            If Len(Cells(pRow, pClumn).Value) > 0 Then
77                Cells(pRow, pClumn).NumberFormatLocal = "yyyy/m/d;@"
78                inStrVal = InStr(Cells(pRow, pClumn).Value, "(")
79                If inStrVal > 0 Then
80                    afterCellVal = Left(Cells(pRow, pClumn).Value, inStrVal - 1)
81                    Cells(pRow, pClumn).Value = CDate("20" + afterCellVal)
82                End If
83            Else
84                Exit For
85            End If
86        Next pRow
87    End Sub
88    
89    '着手状況、完了状況の判別に必要な対象列引数として、SetCellsConditionCheckに渡す。
90    Sub SetCells()
91        Call SetCellsConditionCheck(2)
92        Call SetCellsConditionCheck(3)
93    End Sub
94    
95    'セル情報と、そのセルの期間パターン、進捗状況パターンを引数として、SetCellに渡す。
96    Sub SetCellsConditionCheck(pClumn As Integer)
97        For pRow = 6 To rowsCount
98        
99            '期間セット
100            pCellDate = Cells(pRow, pClumn).Value
101            '期間パターンを格納する変数
102            Dim pDuringPattern As Integer
103            '期間パターンセット
104            pDuringPattern = CheckDuringPattern(pCellDate)
105            
106            
107            '進捗状況セット
108            cellDataD = Cells(pRow, 4).Value
109            '進捗状況を格納する変数
110            Dim pProgressSituation As Integer
111            '進捗状況パターンセット
112            pProgressSituation = CheckProgressSituation(cellDataD)
113            
114
115            'セルに文字をセットする処理
116            Call SetCell(pRow, pClumn, pDuringPattern, pProgressSituation)
117            
118        Next pRow
119    End Sub
120    
121    '対象セルへの文字列セット処理。
122    Sub SetCell(pRow As Variant, pClumn As Integer, pDuringPattern As Integer, pProgressSituation As Integer)
123        
124        '対象セルにセットする文字を格納する変数
125        Dim pString As String
126        
127        If pClumn = 2 Then
128            If pDuringPattern = 4 Then
129                Select Case pProgressSituation
130                    Case 0, 2
131                        pString = C_START_FIRST
132                    Case 1
133                        pString = C_START_EMP
134                End Select
135            Else
136                Select Case pProgressSituation
137                    Case 0, 2
138                        pString = C_START
139                    Case 1
140                        pString = C_START_LATE
141                End Select
142            End If
143        ElseIf pClumn = 3 Then
144            If pDuringPattern = 4 Then
145                Select Case pProgressSituation
146                    Case 0
147                        pString = C_END_FIRST
148                    Case 1, 2
149                        pString = C_END_EMP
150                End Select
151            Else
152                Select Case pProgressSituation
153                    Case 0
154                        pString = C_END
155                    Case 1, 2
156                        pString = C_END_LATE
157                End Select
158            End If
159        End If
160                
161        '対象セルへの文字セット
162        Cells(pRow, pClumn + 3).Value = pString
163        
164        'カラー設定
165        If pString = C_START_LATE Or pString = C_END_LATE Then
166            Call SetColor(pRow, pClumn + 3, C_RED)
167        Else
168            Call SetColor(pRow, pClumn + 3, C_BLACK)
169        End If
170        
171    End Sub
172    
173    '期間パターンの判定処理
174    Function CheckDuringPattern(pCellDate As Variant) As Integer
175        If pCellDate < cellDateFrom Then
176                CheckDuringPattern = 0
177            ElseIf pCellDate = cellDateFrom Then
178                CheckDuringPattern = 1
179            ElseIf cellDateFrom < pCellDate And pCellDate < cellDateTo Then
180                CheckDuringPattern = 2
181            ElseIf pCellDate = cellDateTo Then
182                CheckDuringPattern = 3
183            ElseIf cellDateTo < pCellDate Then
184                CheckDuringPattern = 4
185            End If
186    End Function
187    
188    '進捗状況パターンの判定処理
189    Function CheckProgressSituation(cellDataD As Integer) As Integer
190            If cellDataD = 100 Then
191                CheckProgressSituation = 0
192            ElseIf cellDataD = 0 Then
193                CheckProgressSituation = 1
194            ElseIf 1 < cellDataD And cellDataD < 100 Then
195                CheckProgressSituation = 2
196            End If
197    End Function
198    
199    'B3,C3のセルデータを削除する。
200    Sub ResetInputDataReports()
201        Range("B3:C3").Select
202        Selection.ClearContents
203    End Sub
204    
205    'B6～F6の6行目から最終行までのセルデータを削除する。
206    Sub ResetInputDataProjects()
207        Range("B6:F6").Select
208        Range(Selection, Selection.End(xlDown)).Select
209        Selection.ClearContents
210    End Sub
211    
212    '対象セルの文字色をpColorIndexの指定色に設定する。
213    Sub SetColor(pRow As Variant, pClumn As Integer, pColorIndex As Integer)
214        Cells(pRow, pClumn).Select
215        With Selection.Font
216            .ColorIndex = pColorIndex
217            .TintAndShade = 0
218        End With
219    End Sub
220    
221    'E6～F6の6行目から最終行までの文字色を黒に設定する。
222    Sub ResetColors()
223        Range("B6:F6").Select
224        Range(Selection, Selection.End(xlDown)).Select
225        With Selection.Font
226            .ColorIndex = 1
227            .TintAndShade = 0
228        End With
229    End Sub
230

ozwk

2017/10/03 08:17 編集

0件や100件など少ない件数に対して処理時間はどうですか?4秒ぐらいかかったりしてませんか?

King_of_Flies

2017/10/03 08:22

試してないですが、Time()ではすべて一秒以内の計測になってしまうので、測定結果は変わらないと思います。ほかに処理時間の測定に使えそうなメソッドはありますか？

ozwk

2017/10/03 08:22

測定部分含めてコード貼ってください

King_of_Flies

2017/10/03 08:27

コードを添付しました。

King_of_Flies

2017/10/03 08:49

１＞編集履歴で45件、90件、135件、180件のデータ9回分の処理速度が見れると思うので確認してください。二回目の編集あたりになります。

行動規範の内容に同意します

回答2件

ベストアンサー

私の環境で動作してみたところ、同じ件数でも平均から外れることがありました。
また平均的な時間で動作している限りはデータ件数に比例した時間になっているようでした。
自環境での処理結果は以下の通りです。
1500件：6秒
3000件：12秒
4500件：18秒前後（うち１回だけ15秒）
6000件：24秒前後（うち１回だけ21秒）

このようにちょっと動作が異なっているようでしたので推測を含む回答になってしみますが、それも踏まえてアドバイスさせていただきます。

まず、Excelで処理が遅くなる大きな原因の一つとして、画面描画があります。
単純に画面描画がないだけで格段に処理が早くなります。
例えば画面には30行目まで表示されているとして、３０行目までは画面をチラつかせながらゆっくり処理が進み、31行目からは高速に処理が進んだりします。

今回のコードでは処理中にセルのSelectが行われているため、対象セルが順次表示される画面描画が発生しています。

自環境で平均から外れる時間で終了したケースでは、処理の途中から画面描画がおいつかず、処理終了後にメッセージが表示されて画面も描画されるという動きをしていました。
画面描画がされなくなったのはおそらく処理落ちだと思いますが、結果として画面を描画しない分早く処理が終了したものと思います。

逆にすべてのセル描画が行われた場合は、データ量に比例した時間で終了したのではないかと思います。

画面描画の時間が今回の現象に関与しているかどうかは、処理中の画面描画をOFFにしてみればわかると思います。

Sub 実行()
        Debug.Print Time()
        Application.ScreenUpdating = False        '画面描画OFF
        Call SetReportDate
        Call SetRows
        Call EditFormats
        Call SetCells
        Range("A1").Select
        Debug.Print Time()
        Application.ScreenUpdating = True        '画面描画ON
        MsgBox ("処理が正常に完了しました。")
End Sub

これで処理時間がデータ量に比例するようになるかはわかりませんが、お試しください。

投稿2017/10/03 13:24