teratail
回答率
85.25%
質問するログイン新規登録
トップVBAに関する質問VBAの進捗を可視化したい(プログレスバー)

Q&A

1回答

241閲覧

VBAの進捗を可視化したい(プログレスバー)

Coco_K6
Coco

総合スコア0

VBA

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

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Excel

0グッド

1クリップ

投稿2026/07/01 13:13

0

1

実現したいこと

初めまして。VBA触りたての初心者です。
参考サイトを見ながら、一つのエクセルシートのデータを項目ごとに分けるVBAを組みました。(正常に稼働します)処理に時間がかからこともあり、おおよその終了時間や処理のパーセントが分かればいいなと思い、方法を探していました。その中でプログレスバーというものがあるとのことで、使用したいと思ったのですが、プログレスバーを動かすためのコードの書き方やシート分けのVBAのどの部分にプログレスバーのマクロを組み込めばいいかわからず困っています。ご助力頂ける方がいましたら嬉しく思います...!
拙い内容で申し訳ございません。少しでもお力添え頂けましたら嬉しいです。よろしくお願いいたします！

(シート分けの参考：https://fastclassinfo.com/entry/vba_sheet_tenki/）
★実現したいこと
・参考先のようなバーを作成したい　
・大体の終わる時間を処理中に表示させたい
・バーが伸びていくようにしたい（ラベルを使用する）
・完了のメッセージボックスに、最終的な処理時間をのせたい
プログレスバーの参考：https://qiita.com/hetare001/items/ec062f4e9d3e91c9d2ee

発生している問題・分からないこと

参考サイトのようなプログレスバー(ラベルが伸びるように見えるもの)を作成したく、コードをどのように書けばいいか教えて欲しい
②VBAのどの部分に、プログレスバーのコードを加えればいいかわからない

該当のソースコード

Excel
1'プログラム0｜変数設定の指定
2Option Explicit
3
4'プログラム1｜プログラム開始
5Sub CreateSheets()
6
7　Appication.ScreenUpdating = False
8
9    'プログラム2｜シート設定
10    Dim ws1 As Worksheet, ws2 As Worksheet
11    Set ws1 = ThisWorkbook.Worksheets("マクロ")
12    Set ws2 = ThisWorkbook.Worksheets("template")
13
14    'プログラム3｜最終行を取得
15    Dim cmax1 As Long
16    cmax1 = ws1.Range("AV1048576").End(xlUp).Row
17
18    'プログラム4｜「マクロ」シートをコピーして重複削除
19    Dim ws3 As Worksheet
20    ws1.Copy after:=ThisWorkbook.Worksheets(Worksheets.Count)
21    Set ws3 = ThisWorkbook.ActiveSheet
22    ws3.Range("A:AV").RemoveDuplicates Columns:=Array(48), Header:=xlYes
23
24    'プログラム5｜プログラム4で重複削除したシートの最終行を取得
25    Dim cmax2 As Long
26    cmax2 = ws3.Range("AV1048576").End(xlUp).Row
27
28    'プログラム6｜コピーしたシートを並び替え
29    With ws3.Sort
30        .SortFields.Clear
31        .SortFields.Add Key:=ws3.Range("AV1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
32        .SetRange ws2.Range("A2:AV" & cmax2)
33        .Header = xlNo
34        .MatchCase = False
35        .Orientation = xlTopToBottom
36        .SortMethod = xlPinYin
37        .Apply
38    End With
39
40    'プログラム7｜重複削除、並び替えしたシートの2行目から最終行まで処理
41    Dim i As Long
42    For i = 2 To cmax2
43        Dim sample As String
44        sample = ws3.Range("AV" & i).Value
45
46        'プログラム8｜「template」シートをコピー
47        Dim ws4 As Worksheet
48        ws2.Copy after:=ThisWorkbook.Worksheets(Worksheets.Count)
49        Set ws4 = ThisWorkbook.ActiveSheet
50
51        'プログラム9｜コピーした「template」シートの名前を変更
52        ws4.Name = sample
53
54        'プログラム10｜転記先の行数をn=2で初期化
55        Dim n As Long: n = 2
56
57        'プログラム11｜「nouhin」シートのA列がtorihikiと一致したら転記
58        Dim j As Long
59        For j = 2 To cmax1
60            If sample = ws1.Range("AV" & j).Value Then
61                ws4.Range("A" & n & ":AV" & n).Value = ws1.Range("A" & j & ":AV" & j).Value
62                n = n + 1
63            End If
64        Next
65
66        'プログラム12｜オブジェクト解放
67        Set ws4 = Nothing
68    Next
69
70    'プログラム13｜重複削除、並び替えしたシートを削除
71    Application.DisplayAlerts = False
72    ws3.Delete
73    Application.DisplayAlerts = True
74
75    'プログラム14｜新しいエクセルファイルとして保存
76    Dim newfilename As String
77    newfilename = Format(Date, "yyyy-mm-dd") & "_" & ThisWorkbook.Name
78    Application.DisplayAlerts = False
79    ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & newfilename
80    Application.DisplayAlerts = True
81
82　MsgBox　"シート分けが完了しました", vbInformation
83 Application.ScreenUpdating = True
84
85'プログラム15｜プログラム終了
86End Sub

試したこと・調べたこと

  • teratailやGoogle等で検索した
  • ソースコードを自分なりに変更した
  • 知人に聞いた
  • その他
上記の詳細・結果

シート分けのマクロは正常に稼働するようになりました！
プログレスバーの作成方法はなんとなく分かりましたがコードがうまく出来ず、プログレスバーを表示させること、動かすことができませんでした。

補足

◎シート分けのマクロの組んでいるエクセルブックについて
・シートは３種（参照、マクロ、template）
・AV列は　参照　のシートからVLOOKUPでデータを引っ張ってきている

気になる質問をクリップする

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

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

guest

回答1件

0

こちらでどうでしょうか。一応これで動作確認できています。
実際のコードに組み込んでしまうと動作確認できなくて、簡易コード組んでいます。
プログレスバー、残り時間はシンプルにするためにループ処理の部分のみを計算対象にしています。
総処理時間はトータルで計測しています。
実際のコードに組み込みましょうか？

あと、ユーザーフォームの作り方は分かりますか？
ユーザーフォームのほうではLabel1のうえにLabel2を重ねています。

久々にこちらで回答したので不手際あったらすみません。
※コードはGoogle検索AIモード(Gemini)で出力してもらったのをベースに手を加えたものです。

VBA
1Sub 簡易プログレスバーテスト()
2
3    Dim maxBarWidth As Single
4    Dim totalSteps As Long
5
6    Dim 進捗率 As Double
7    Dim 経過時間 As Double
8    Dim 残り時間 As Double
9    Dim 総処理数 As Long
10    Dim 現在の処理数 As Long
11    
12    Dim 全体開始時間 As Double
13    Dim ループ開始時間 As Double
14    
15    
16    maxBarWidth = 120
17    totalSteps = 10
18
19    Application.ScreenUpdating = False
20    
21
22
23    UserForm1.Label1.BackColor = RGB(180, 180, 180)       ' やや濃いグレー
24    UserForm1.Label1.Width = maxBarWidth
25    UserForm1.Label1.Caption = ""
26
27    
28    UserForm1.Label2.BackColor = RGB(0, 200, 100)   ' 緑
29    UserForm1.Label2.Width = 0
30    UserForm1.Label2.Caption = ""
31     
32    UserForm1.Label3.AutoSize = True
33    UserForm1.Label3.WordWrap = False
34    UserForm1.Label4.AutoSize = True
35    UserForm1.Label4.WordWrap = False
36    UserForm1.Label4.Caption = ""
37    
38    UserForm1.Show vbModeless
39    
40    全体開始時間 = Timer
41    
42    ' ★【ステータス：前処理】
43    UserForm1.Label3.Caption = "【前処理中】データを読み込んでいます..."
44    DoEvents
45
46    ' VBA標準の機能で2秒待つ
47    Application.Wait [Now() + "00:00:02"]
48
49
50    Dim i As Long
51    ループ開始時間 = Timer
52    総処理数 = totalSteps - 1 'iが2スタートなのでー１してます。
53    
54    For i = 2 To totalSteps
55        
56        Application.Wait [Now() + "00:00:01"]
57
58
59        ' プログレスバーの更新
60        現在の処理数 = i - 1 'iが2スタートなので-1してます。
61        進捗率 = 現在の処理数 / 総処理数
62        経過時間 = Timer - ループ開始時間
63        残り時間 = 0
64
65        ' 残り時間の予測計算
66        If 進捗率 > 0 Then
67            残り時間 = (経過時間 / 進捗率) - 経過時間
68        End If
69        
70        ' フォームの表示を更新
71        UserForm1.Label2.Width = maxBarWidth * 進捗率
72        UserForm1.Label3.Caption = "【ループ処理中】 " & i - 1 & " / " & totalSteps - 1 & " 回目の処理"
73        UserForm1.Label4.Caption = Format(進捗率, "0%") & " 完了 (残り約 " & Format(残り時間, "0") & " 秒)"
74        
75        ' 画面を強制的に描き替える
76        DoEvents
77        
78    Next i
79
80    ' ★【ステータス：後処理】
81    UserForm1.Label3.Caption = "【後処理中】ファイルを保存しています..."
82    DoEvents
83    
84    ' 後処理のウェイトとして2秒待つ
85    Application.Wait [Now() + "00:00:02"]
86
87    ' フォームを閉じる
88    Unload UserForm1
89
90    ' 最終的な処理時間を表示
91    Dim totalTime As Double
92    totalTime = Timer - 全体開始時間
93    MsgBox "擬似処理が完了しました！" & vbCrLf & _
94           "総処理時間: " & Format(totalTime, "0.00秒"), vbInformation
95           
96    Application.ScreenUpdating = True
97
98End Sub

イメージ説明

追記　2026/07/03　---------------------------------
実際のコードに組み込む位置です。長いので手を加えない部分は省略してあります。
シート1枚ごとにプログレスバー更新すると頻度が多すぎる可能性があり速度低下の懸念もあるため、5シートごとに1回更新するようになってます。頻度は自分で調整してみてください。
※コードはGoogle検索AIモード(Gemini)で出力してもらったのです。

VBA
1'プログラム0｜変数設定の指定
2Option Explicit
3
4'プログラム1｜プログラム開始
5Sub CreateSheets()
6
7    ' ★【追加】プログレスバー用の変数設定
8    Dim maxBarWidth As Single
9    Dim 全体開始時間 As Double
10    Dim ループ開始時間 As Double
11    Dim 進捗率 As Double
12    Dim 経過時間 As Double
13    Dim 残り時間 As Double
14    Dim 総処理数 As Long
15    Dim 現在の処理数 As Long
16    Dim 最終時間 As Double
17    Dim updateInterval As Long
18    
19    ' プログレスバーの最大横幅（お好みに合わせて調整してください）
20    maxBarWidth = 120
21    ' 5シートごとに1回バーを更新する設定（速度低下を防ぐ対策）
22    updateInterval = 5
23
24    ' ★【追加】マクロ全体の開始時間を記録
25    全体開始時間 = Timer
26
27    ' ❌（修正箇所）スペルミスをApplicationに直しておきます
28    Application.ScreenUpdating = False
29
30    ' ★【追加】プログレスバーの初期設定と前処理ステータスの表示
31    UserForm1.Label1.BackColor = RGB(180, 180, 180) ' 土台を濃いグレーに
32    UserForm1.Label1.Width = maxBarWidth
33    UserForm1.Label1.Caption = ""
34
35    UserForm1.Label2.BackColor = RGB(0, 200, 100)   ' 伸びるバーを緑色に
36    UserForm1.Label2.Width = 0
37    UserForm1.Label2.Caption = ""
38     
39    UserForm1.Label3.AutoSize = True
40    UserForm1.Label3.WordWrap = False
41    UserForm1.Label4.AutoSize = True
42    UserForm1.Label4.WordWrap = False
43    UserForm1.Label4.Caption = ""
44    
45    UserForm1.Label3.Caption = "【前処理中】データの準備をしています..."
46    UserForm1.Show vbModeless ' モードレスでフォームを表示
47    DoEvents
48
49    ' --------------------------------------------------
50    ' 【プログラム2 〜 プログラム6 の処理（省略）】
51    ' シート設定、最終行取得、重複削除、並び替えなどの元の処理が入ります
52    ' --------------------------------------------------
53
54    ' ★【追加】純粋なループ処理が始まる時間を記録、および総処理数の計算
55    Dim i As Long
56    ループ開始時間 = Timer
57    総処理数 = cmax2 - 1 ' 2行目スタートなので-1
58    
59    'プログラム7｜重複削除、並び替えしたシートの2行目から最終行まで処理
60    For i = 2 To cmax2
61        Dim sample As String
62        sample = ws3.Range("AV" & i).Value
63
64        ' --------------------------------------------------
65        ' 【プログラム8 〜 プログラム12 の処理（省略）】
66        ' templateコピー、名前変更、プログラム11の「転記ループ(jのループ)」が入ります
67        ' --------------------------------------------------
68
69        ' ★【追加】プログレスバーの更新（指定した回数ごと、または最後の回に実行）
70        現在の処理数 = i - 1
71        If 現在の処理数 Mod updateInterval = 0 Or 現在の処理数 = 総処理数 Then
72            
73            進捗率 = 現在の処理数 / 総処理数
74            経過時間 = Timer - ループ開始時間
75            残り時間 = 0
76
77            ' 残り時間の予測計算
78            If 進捗率 > 0 Then
79                残り時間 = (経過時間 / 進捗率) - 経過時間
80            End If
81            
82            ' フォームの表示を更新
83            UserForm1.Label2.Width = maxBarWidth * 進捗率
84            UserForm1.Label3.Caption = "【シート作成中】 " & 現在の処理数 & " / " & 総処理数 & " シート目"
85            UserForm1.Label4.Caption = Format(進捗率, "0%") & " 完了 (残り約 " & Format(残り時間, "0") & " 秒)"
86            
87            ' 画面を強制的に描き替えるおまじない
88            DoEvents
89        End If
90        
91    Next i
92
93    ' ★【追加】後処理ステータスの表示
94    UserForm1.Label3.Caption = "【後処理中】ファイルを保存しています..."
95    DoEvents
96
97    ' --------------------------------------------------
98    ' 【プログラム13 〜 プログラム14 の処理（省略）】
99    ' 重複削除シートの削除、新しいファイルとして保存の処理が入ります
100    ' --------------------------------------------------
101
102    ' ★【追加】すべて終わったらフォームを閉じる
103    Unload UserForm1
104
105    ' ★【追加】最終的なトータルの処理時間をメッセージボックスに表示
106    最終時間 = Timer - 全体開始時間
107    MsgBox "シート分けが完了しました！" & vbCrLf & _
108           "総処理時間: " & Format(最終時間, "0.00秒"), vbInformation
109           
110    Application.ScreenUpdating = True
111
112'プログラム15｜プログラム終了
113End Sub

投稿2026/07/01 22:13

編集2026/07/03 01:44
hawawa
hawawa

総合スコア91

Coco_K6
Coco

2026/07/02 12:21

hawawa神様 コメントありがとうございます！ 頂いたコードを試してみるため、新規EXCELにて行ってみたところイメージ通りに稼働しました！(バーが動いてて感動しました！). ただ、自分では実際のコードなどの部分に組み込めばいいか分からないため、教えて頂けましたら嬉しいです。 また、UserFormにも直接コードを書けるかと思うのですが、そこにも何か書く必要はあるのでしょうか？ 初心者の質問で申し訳ございません...
hawawa
hawawa

2026/07/02 17:33

今回は標準モジュールからユーザーフォームの操作も行っていますので、フォームモジュールのほうは何も記述しなくて大丈夫ですね。組み込んだコード作ってみますがちょっとお待ちください。 なるべくミスなくやりますが、いかんせん動作確認できないのでどこか間違っててもこちらではデバッグできないです。
Coco_K6
Coco

2026/07/03 11:34

こんばんは！ フォームモジュールについて、記載しなくていいとのこと承知いたしました。 お時間ある時で大丈夫です！少しでもヒントをいただけるだけで、本当に助かります。お手数をおかけしてしまい申し訳ございません。よろしくお願いいたします...!
hawawa
hawawa

2026/07/03 15:30

本文のほうに追記で記載してあります。コメントし忘れました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

質問の解決につながる回答をしましょう。 サンプルコードなど、より具体的な説明があると質問者の理解の助けになります。 また、読む側のことを考えた、分かりやすい文章を心がけましょう。

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

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

ただいまの回答率
85.25%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問

トップVBAに関する質問

VBAの進捗を可視化したい(プログレスバー)