質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

91.02%

  • VBA

    1415questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

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

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 161

King_of_Flies

score 292

お疲れ様です。
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などの処理高速化はされていないようでした。

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

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

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

よろしくお願いします。

 'セルにセットする文字列を格納した定数
    Const C_START_FIRST As String = "先行着手"
    Const C_START As String = "着手"
    Const C_START_LATE As String = "遅れ"
    Const C_START_EMP As String = ""

    Const C_END_FIRST As String = "先行完了"
    Const C_END As String = "完了"
    Const C_END_LATE As String = "遅れ"
    Const C_END_EMP As String = ""


    'ColorIndex用の色識別定数
    Const C_BLACK As Integer = 1
    Const C_RED As Integer = 3
    Const C_ORANGE As Integer = 45
    Const C_GREEN As Integer = 4


    'データ行数を格納する変数。
    Dim rowsCount As Integer

    'セル内のデータを格納する変数。
    Dim cellDateFrom As Date
    Dim cellDateTo As Date
    Dim cellDateB As Variant
    Dim cellDateC As Variant
    Dim cellDataD As Integer

Sub 実行()
        Debug.Print Time()
        Call SetReportDate
        Call SetRows
        Call EditFormats
        Call SetCells
        Range("A1").Select
        Debug.Print Time()
        MsgBox ("処理が正常に完了しました。")
End Sub

'報告期間FROMと報告期間TOを取得する。
    Sub SetReportDate()
        cellDateFrom = Cells(3, 2).Value
        cellDateTo = Cells(3, 3).Value
        If cellDateFrom = "0:00:00" Or cellDateTo = "0:00:00" Or cellDateFrom = Empty Or cellDateTo = Empty Then
            MsgBox ("報告期間FROMまたは報告期間TOが入力されていません。")
            End
        End If
    End Sub

    'ユーザが入力したデータの行数をrowsCountにセットする。
    Sub SetRows()
        Range("B6").Select
        If Range("B6").Value = Empty Then
            MsgBox ("作業着手予定日が入力されていないか、行頭から入力されていません。")
            End
        Else
            Range(Selection, Selection.End(xlDown)).Select
            rowsCount = Selection.rows.count + 5
        End If
    End Sub

    '変換対象列引数として、EditFormatに渡す。
    Sub EditFormats()
        Call EditFormat(2)
        Call EditFormat(3)
    End Sub

    '"16/09/26(火)"形式の入力を"2016/09/26"形式に整える。
    Sub EditFormat(pClumn As Integer)
        'フォーマット変更時に使用する変数
        Dim inStrVal As Integer
        Dim afterCellVal As String
        '変換対象列の6行目から最終行までを変換する。
        For pRow = 6 To rowsCount
            If Len(Cells(pRow, pClumn).Value) > 0 Then
                Cells(pRow, pClumn).NumberFormatLocal = "yyyy/m/d;@"
                inStrVal = InStr(Cells(pRow, pClumn).Value, "(")
                If inStrVal > 0 Then
                    afterCellVal = Left(Cells(pRow, pClumn).Value, inStrVal - 1)
                    Cells(pRow, pClumn).Value = CDate("20" + afterCellVal)
                End If
            Else
                Exit For
            End If
        Next pRow
    End Sub

    '着手状況、完了状況の判別に必要な対象列引数として、SetCellsConditionCheckに渡す。
    Sub SetCells()
        Call SetCellsConditionCheck(2)
        Call SetCellsConditionCheck(3)
    End Sub

    'セル情報と、そのセルの期間パターン、進捗状況パターンを引数として、SetCellに渡す。
    Sub SetCellsConditionCheck(pClumn As Integer)
        For pRow = 6 To rowsCount

            '期間セット
            pCellDate = Cells(pRow, pClumn).Value
            '期間パターンを格納する変数
            Dim pDuringPattern As Integer
            '期間パターンセット
            pDuringPattern = CheckDuringPattern(pCellDate)


            '進捗状況セット
            cellDataD = Cells(pRow, 4).Value
            '進捗状況を格納する変数
            Dim pProgressSituation As Integer
            '進捗状況パターンセット
            pProgressSituation = CheckProgressSituation(cellDataD)


            'セルに文字をセットする処理
            Call SetCell(pRow, pClumn, pDuringPattern, pProgressSituation)

        Next pRow
    End Sub

    '対象セルへの文字列セット処理。
    Sub SetCell(pRow As Variant, pClumn As Integer, pDuringPattern As Integer, pProgressSituation As Integer)

        '対象セルにセットする文字を格納する変数
        Dim pString As String

        If pClumn = 2 Then
            If pDuringPattern = 4 Then
                Select Case pProgressSituation
                    Case 0, 2
                        pString = C_START_FIRST
                    Case 1
                        pString = C_START_EMP
                End Select
            Else
                Select Case pProgressSituation
                    Case 0, 2
                        pString = C_START
                    Case 1
                        pString = C_START_LATE
                End Select
            End If
        ElseIf pClumn = 3 Then
            If pDuringPattern = 4 Then
                Select Case pProgressSituation
                    Case 0
                        pString = C_END_FIRST
                    Case 1, 2
                        pString = C_END_EMP
                End Select
            Else
                Select Case pProgressSituation
                    Case 0
                        pString = C_END
                    Case 1, 2
                        pString = C_END_LATE
                End Select
            End If
        End If

        '対象セルへの文字セット
        Cells(pRow, pClumn + 3).Value = pString

        'カラー設定
        If pString = C_START_LATE Or pString = C_END_LATE Then
            Call SetColor(pRow, pClumn + 3, C_RED)
        Else
            Call SetColor(pRow, pClumn + 3, C_BLACK)
        End If

    End Sub

    '期間パターンの判定処理
    Function CheckDuringPattern(pCellDate As Variant) As Integer
        If pCellDate < cellDateFrom Then
                CheckDuringPattern = 0
            ElseIf pCellDate = cellDateFrom Then
                CheckDuringPattern = 1
            ElseIf cellDateFrom < pCellDate And pCellDate < cellDateTo Then
                CheckDuringPattern = 2
            ElseIf pCellDate = cellDateTo Then
                CheckDuringPattern = 3
            ElseIf cellDateTo < pCellDate Then
                CheckDuringPattern = 4
            End If
    End Function

    '進捗状況パターンの判定処理
    Function CheckProgressSituation(cellDataD As Integer) As Integer
            If cellDataD = 100 Then
                CheckProgressSituation = 0
            ElseIf cellDataD = 0 Then
                CheckProgressSituation = 1
            ElseIf 1 < cellDataD And cellDataD < 100 Then
                CheckProgressSituation = 2
            End If
    End Function

    'B3,C3のセルデータを削除する。
    Sub ResetInputDataReports()
        Range("B3:C3").Select
        Selection.ClearContents
    End Sub

    'B6~F6の6行目から最終行までのセルデータを削除する。
    Sub ResetInputDataProjects()
        Range("B6:F6").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.ClearContents
    End Sub

    '対象セルの文字色をpColorIndexの指定色に設定する。
    Sub SetColor(pRow As Variant, pClumn As Integer, pColorIndex As Integer)
        Cells(pRow, pClumn).Select
        With Selection.Font
            .ColorIndex = pColorIndex
            .TintAndShade = 0
        End With
    End Sub

    'E6~F6の6行目から最終行までの文字色を黒に設定する。
    Sub ResetColors()
        Range("B6:F6").Select
        Range(Selection, Selection.End(xlDown)).Select
        With Selection.Font
            .ColorIndex = 1
            .TintAndShade = 0
        End With
    End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • ozwk

    2017/10/03 17:22

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

    キャンセル

  • King_of_Flies

    2017/10/03 17:27

    コードを添付しました。

    キャンセル

  • King_of_Flies

    2017/10/03 17:49

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

    キャンセル

回答 2

checkベストアンサー

+2

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

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

まず、Excelで処理が遅くなる大きな原因の一つとして、画面描画があります。
単純に画面描画がないだけで格段に処理が早くなります。
例えば画面には30行目まで表示されているとして、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/04 09:04

    画面描写をなしにすることで処理がとても速くなりました。

    ありがとうございました。

    キャンセル

  • 2017/10/04 09:05

    1440件 6秒が 2秒にまで短縮され、大変助かりました。

    キャンセル

0

疑問の解決になったかはわかりませんが、お力になれたようで何よりです。(^-^)

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/10/04 09:47

    コメント欄と解答欄を間違えて投稿してしまいました(*_*)

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 91.02%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • VBA

    1415questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。