回答編集履歴
3
実際のコードに記述する場所を追記しました。
answer
CHANGED
|
@@ -110,4 +110,125 @@
|
|
|
110
110
|
|
|
111
111
|
End Sub
|
|
112
112
|
```
|
|
113
|
-
|
|
113
|
+
|
|
114
|
+
|
|
115
|
+
|
|
116
|
+
追記 2026/07/03 ---------------------------------
|
|
117
|
+
実際のコードに組み込む位置です。長いので手を加えない部分は省略してあります。
|
|
118
|
+
シート1枚ごとにプログレスバー更新すると頻度が多すぎる可能性があり速度低下の懸念もあるため、5シートごとに1回更新するようになってます。頻度は自分で調整してみてください。
|
|
119
|
+
※コードはGoogle検索AIモード(Gemini)で出力してもらったのです。
|
|
120
|
+
```VBA
|
|
121
|
+
'プログラム0｜変数設定の指定
|
|
122
|
+
Option Explicit
|
|
123
|
+
|
|
124
|
+
'プログラム1｜プログラム開始
|
|
125
|
+
Sub CreateSheets()
|
|
126
|
+
|
|
127
|
+
' ★【追加】プログレスバー用の変数設定
|
|
128
|
+
Dim maxBarWidth As Single
|
|
129
|
+
Dim 全体開始時間 As Double
|
|
130
|
+
Dim ループ開始時間 As Double
|
|
131
|
+
Dim 進捗率 As Double
|
|
132
|
+
Dim 経過時間 As Double
|
|
133
|
+
Dim 残り時間 As Double
|
|
134
|
+
Dim 総処理数 As Long
|
|
135
|
+
Dim 現在の処理数 As Long
|
|
136
|
+
Dim 最終時間 As Double
|
|
137
|
+
Dim updateInterval As Long
|
|
138
|
+
|
|
139
|
+
' プログレスバーの最大横幅（お好みに合わせて調整してください）
|
|
140
|
+
maxBarWidth = 120
|
|
141
|
+
' 5シートごとに1回バーを更新する設定（速度低下を防ぐ対策）
|
|
142
|
+
updateInterval = 5
|
|
143
|
+
|
|
144
|
+
' ★【追加】マクロ全体の開始時間を記録
|
|
145
|
+
全体開始時間 = Timer
|
|
146
|
+
|
|
147
|
+
' ❌（修正箇所）スペルミスをApplicationに直しておきます
|
|
148
|
+
Application.ScreenUpdating = False
|
|
149
|
+
|
|
150
|
+
' ★【追加】プログレスバーの初期設定と前処理ステータスの表示
|
|
151
|
+
UserForm1.Label1.BackColor = RGB(180, 180, 180) ' 土台を濃いグレーに
|
|
152
|
+
UserForm1.Label1.Width = maxBarWidth
|
|
153
|
+
UserForm1.Label1.Caption = ""
|
|
154
|
+
|
|
155
|
+
UserForm1.Label2.BackColor = RGB(0, 200, 100) ' 伸びるバーを緑色に
|
|
156
|
+
UserForm1.Label2.Width = 0
|
|
157
|
+
UserForm1.Label2.Caption = ""
|
|
158
|
+
|
|
159
|
+
UserForm1.Label3.AutoSize = True
|
|
160
|
+
UserForm1.Label3.WordWrap = False
|
|
161
|
+
UserForm1.Label4.AutoSize = True
|
|
162
|
+
UserForm1.Label4.WordWrap = False
|
|
163
|
+
UserForm1.Label4.Caption = ""
|
|
164
|
+
|
|
165
|
+
UserForm1.Label3.Caption = "【前処理中】データの準備をしています..."
|
|
166
|
+
UserForm1.Show vbModeless ' モードレスでフォームを表示
|
|
167
|
+
DoEvents
|
|
168
|
+
|
|
169
|
+
' --------------------------------------------------
|
|
170
|
+
' 【プログラム2 〜 プログラム6 の処理（省略）】
|
|
171
|
+
' シート設定、最終行取得、重複削除、並び替えなどの元の処理が入ります
|
|
172
|
+
' --------------------------------------------------
|
|
173
|
+
|
|
174
|
+
' ★【追加】純粋なループ処理が始まる時間を記録、および総処理数の計算
|
|
175
|
+
Dim i As Long
|
|
176
|
+
ループ開始時間 = Timer
|
|
177
|
+
総処理数 = cmax2 - 1 ' 2行目スタートなので-1
|
|
178
|
+
|
|
179
|
+
'プログラム7｜重複削除、並び替えしたシートの2行目から最終行まで処理
|
|
180
|
+
For i = 2 To cmax2
|
|
181
|
+
Dim sample As String
|
|
182
|
+
sample = ws3.Range("AV" & i).Value
|
|
183
|
+
|
|
184
|
+
' --------------------------------------------------
|
|
185
|
+
' 【プログラム8 〜 プログラム12 の処理（省略）】
|
|
186
|
+
' templateコピー、名前変更、プログラム11の「転記ループ(jのループ)」が入ります
|
|
187
|
+
' --------------------------------------------------
|
|
188
|
+
|
|
189
|
+
' ★【追加】プログレスバーの更新（指定した回数ごと、または最後の回に実行）
|
|
190
|
+
現在の処理数 = i - 1
|
|
191
|
+
If 現在の処理数 Mod updateInterval = 0 Or 現在の処理数 = 総処理数 Then
|
|
192
|
+
|
|
193
|
+
進捗率 = 現在の処理数 / 総処理数
|
|
194
|
+
経過時間 = Timer - ループ開始時間
|
|
195
|
+
残り時間 = 0
|
|
196
|
+
|
|
197
|
+
' 残り時間の予測計算
|
|
198
|
+
If 進捗率 > 0 Then
|
|
199
|
+
残り時間 = (経過時間 / 進捗率) - 経過時間
|
|
200
|
+
End If
|
|
201
|
+
|
|
202
|
+
' フォームの表示を更新
|
|
203
|
+
UserForm1.Label2.Width = maxBarWidth * 進捗率
|
|
204
|
+
UserForm1.Label3.Caption = "【シート作成中】 " & 現在の処理数 & " / " & 総処理数 & " シート目"
|
|
205
|
+
UserForm1.Label4.Caption = Format(進捗率, "0%") & " 完了 (残り約 " & Format(残り時間, "0") & " 秒)"
|
|
206
|
+
|
|
207
|
+
' 画面を強制的に描き替えるおまじない
|
|
208
|
+
DoEvents
|
|
209
|
+
End If
|
|
210
|
+
|
|
211
|
+
Next i
|
|
212
|
+
|
|
213
|
+
' ★【追加】後処理ステータスの表示
|
|
214
|
+
UserForm1.Label3.Caption = "【後処理中】ファイルを保存しています..."
|
|
215
|
+
DoEvents
|
|
216
|
+
|
|
217
|
+
' --------------------------------------------------
|
|
218
|
+
' 【プログラム13 〜 プログラム14 の処理（省略）】
|
|
219
|
+
' 重複削除シートの削除、新しいファイルとして保存の処理が入ります
|
|
220
|
+
' --------------------------------------------------
|
|
221
|
+
|
|
222
|
+
' ★【追加】すべて終わったらフォームを閉じる
|
|
223
|
+
Unload UserForm1
|
|
224
|
+
|
|
225
|
+
' ★【追加】最終的なトータルの処理時間をメッセージボックスに表示
|
|
226
|
+
最終時間 = Timer - 全体開始時間
|
|
227
|
+
MsgBox "シート分けが完了しました！" & vbCrLf & _
|
|
228
|
+
"総処理時間: " & Format(最終時間, "0.00秒"), vbInformation
|
|
229
|
+
|
|
230
|
+
Application.ScreenUpdating = True
|
|
231
|
+
|
|
232
|
+
'プログラム15｜プログラム終了
|
|
233
|
+
End Sub
|
|
234
|
+
```
|
2
誤字修正
answer
CHANGED
|
@@ -56,7 +56,7 @@
|
|
|
56
56
|
UserForm1.Label3.Caption = "【前処理中】データを読み込んでいます..."
|
|
57
57
|
DoEvents
|
|
58
58
|
|
|
59
|
-
' VBA標準の機能で
|
|
59
|
+
' VBA標準の機能で2秒待つ
|
|
60
60
|
Application.Wait [Now() + "00:00:02"]
|
|
61
61
|
|
|
62
62
|
|
|
@@ -94,7 +94,7 @@
|
|
|
94
94
|
UserForm1.Label3.Caption = "【後処理中】ファイルを保存しています..."
|
|
95
95
|
DoEvents
|
|
96
96
|
|
|
97
|
-
' 後処理のウェイトとして
|
|
97
|
+
' 後処理のウェイトとして2秒待つ
|
|
98
98
|
Application.Wait [Now() + "00:00:02"]
|
|
99
99
|
|
|
100
100
|
' フォームを閉じる
|
1
脱字修正
answer
CHANGED
|
@@ -1,7 +1,7 @@
|
|
|
1
1
|
こちらでどうでしょうか。一応これで動作確認できています。
|
|
2
2
|
実際のコードに組み込んでしまうと動作確認できなくて、簡易コード組んでいます。
|
|
3
3
|
プログレスバー、残り時間はシンプルにするためにループ処理の部分のみを計算対象にしています。
|
|
4
|
-
処理時間はトータルで計測しています。
|
|
4
|
+
総処理時間はトータルで計測しています。
|
|
5
5
|
実際のコードに組み込みましょうか？
|
|
6
6
|
|
|
7
7
|
あと、ユーザーフォームの作り方は分かりますか？
|