お疲れ様です。
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
回答2件
あなたの回答
tips
プレビュー