[[20201214161442]]　『VBA プログレスバーの作成について』（太郎）　ページの最後に飛ぶ

『VBA プログレスバーの作成について』（太郎）

Sub test ()
Dim 名前 As Range

  For Each 名前 In Worksheets("情報").Range("B60:B160") '範囲
  If 名前.Value = "" Then Exit For  '空白まで

     Worksheets("原本").Copy After:=Worksheets(Worksheets.count)

     ActiveSheet.Name = 名前.Value
     ActiveSheet.Range("U5") = 名前.Value
     Call 再計算を行う
   Next 名前
End Sub

↑の処理にやたら時間がかかる為、プログレスバーを取り付けたく思っております。
ネットで調べてみたのですが、どう組み合わせるかがわからないので、ご教授おねがいします。

↓が参考にしたコード
Sub test()
Dim i As Long
Dim sum As Long
Dim percent As Integer
Dim count As Long
count = 20000

'プログレスバーFormを表示
UserForm9.Show vbModeless
'プログレスバーの最小値を設定
UserForm9.ProgressBar1.Min = 1
'プログレスバーの最大値を設定
UserForm9.ProgressBar1.Max = count
'プログレスバーの現在値を設定
UserForm9.ProgressBar1.Value = 1

'DoEventsの度にマウスカーソルがちらつく為アイコンを待機中に固定
Application.Cursor = xlWait

'時間の掛かる処理を行う
For i = 0 To count
sum = sum + i

'キャンセルボタン処理
If UserForm9.IsCancel = True Then
'プログレスバーFormを閉じる
Unload UserForm9
'マウスカーソルをデフォルトに戻す
Application.Cursor = xlDefault
MsgBox "処理を中断しました。"
End
'※今回はロールバック処理を考慮せずにバッサリ処理を終了しています。
End If

'プログレスバーの値表示を更新
If UserForm9.ProgressBar1.Min < i And _
UserForm9.ProgressBar1.Max >= i Then

'プログレスバーのLabel表示を更新
percent = CInt(i / count * 100)
UserForm9.Label1.Caption = percent & "%完了"
'プログレスバーの値を更新
UserForm9.ProgressBar1.Value = i
'滞留処理を実行
DoEvents
End If

'結果をセルに表示
ActiveSheet.Cells(1, 1).Value = sum
'プログレスバーFormを閉じる
Unload UserForm9
'マウスカーソルをデフォルトに戻す
Application.Cursor = xlDefault

End Sub

よろしくお願いします。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

 処理時間を短くする方向で注力されたほうが良いのでは？
 どのくらいかかっているかわかりませんが、
 B60:B160まで埋めて、実行しましたが待てないほどではなかったです。
 再計算をForの外側に入れてはどうですか？
    Sub test()
        Dim 名前 As Range
        Dim ws As Worksheet
        Application.Calculation = xlManual
        For Each 名前 In Worksheets("情報").Range("B60:B160") '範囲
            If 名前.Value = "" Then Exit For  '空白まで
            Sheets("原本").Copy After:=Sheets(Sheets.Count)
            With Sheets(Sheets.Count)
                .Name = 名前.Value
                .Range("U5").Value = 名前.Value
            End With
        Next 名前
        Application.Calculation = xlAutomatic
        Call 再計算を行う
    End Sub

（稲葉） 2020/12/14(月) 18:21

回答ありがとうございます。

原本シートに１万セルくらい式がありまして。。。
それをコピーするので、、５分はかからなくともそれなりに掛かっています。

また、再計算のマクロも、アクティブシートのみ計算させるほうで、
自動計算には戻しておりません。。最後には戻しますが。

これをしないととても重たいのです。。

（太郎） 2020/12/14(月) 18:38

 そりゃ重くなりそうですねぇ。　シート構成見直したほうがよさそう・・・

 本題ですが、
 2019はプログレスバーコントロールないみたいですね。
 （VBをインストールすればいいみたいですが、相手環境にもそれを強いる必要があるようです。）
http://www.asahi-net.or.jp/~ef2o-inue/download/sub09_020.html

 エクセル単独で実行する場合は、こちらのプログレスバークラスを使う方法がよさそうです。
 ↑のURLに詳しく載っているので、頑張ってください！

（稲葉） 2020/12/14(月) 19:21

 こんばんは　＾＾
私も、稲葉さんのご案内に賛成です。。。
結構、重くなりますよ。ＧＩＦアニメ[ウインドウズ起動時に
クルクル回るよぉ～な等]か何かこさえて、それを最初に
表示しておいて、終わったら消すとかだと負担が少ないと思います。＾＾；
m(__)m
（隠居じーさん） 2020/12/14(月) 19:26

なるほど、お二人ともありがとうございました。
シート構成の見直しも含めて考えてみます。。m(__)m
（太郎） 2020/12/14(月) 19:37

 解決済み（？）のようですが参考までに
 単に進捗状況を表示したいだけならエクセルのステータスバーに表示することをお勧めします
 余計な処理を追加することもなく実装も簡単です

 ExcelのVBAで処理中に画面が固まらないようにする方法
 http://take3tech.blog.fc2.com/blog-entry-119.html
（ひいらぎ） 2020/12/14(月) 19:41

回答ありがとうございます。助かります。
urlの内容もそうなのですが、「iを使って10000回ループする。」

それ自体は何となくわかるのですが。。。
これをシート作成に当てはめると、どのように変更すればよいのか思いつかないのです。。

もうちょっとお付き合いいただけると幸いです。
よろしくお願いします。

（太郎） 2020/12/14(月) 19:59

最初の質問をよく読んでいませんでした、すみません。
プログレスバーにしろステータスバーにしろ原理は同じで「ループのカウンタ変数i/ループ回数」をユーザーに表示するというものです。
元のコードに組み込むとしたらこんな感じです。

    Sub test()

    Dim i As Long
    Dim lastSheet As Long '追加するシートの合計数
    lastSheet = Sheets("情報").Cells(Rows.Count, 2).End(xlUp).Row - 59

    Dim 名前 As Range

    For Each 名前 In Worksheets("情報").Range("B60:B160") '範囲

        If 名前.Value = "" Then Exit For  '空白まで

        Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = 名前.Value
        ActiveSheet.Range("U5") = 名前.Value

        'Call 再計算を行う

        i = i + 1 '処理済を＋１

        'ステータスバーへの表示更新
        Application.StatusBar = i & "/" & lastSheet & "を完了"
        'エクセルのイベント処理
        DoEvents

    Next 名前

    Application.StatusBar = False

    End Sub

エクセルの画面の左下に「現在処理数／全処理数」で表示されます。ご確認ください。
（そもそも処理内容自体を見直したほうがいいというのは他の方と同意見です）

（ひいらぎ） 2020/12/14(月) 20:56

ご丁寧にありがとうございます！
コピーしただけで動いたのでたすかります！

処理内容についても、考えていきたいと思います。

m(__)m
（太郎） 2020/12/14(月) 21:46

コメント返信：

[ 一覧(最新更新順) ]

[[20201214161442]] 『VBA プログレスバーの作成について』（太郎） ページの最後に飛ぶ

[[20201214161442]]　『VBA プログレスバーの作成について』（太郎）　ページの最後に飛ぶ