VBA初心者で、とりあえず頑張って作ってみました。以下のVBAでの修正点を教えてください。
(英単語の小テスト用につくりました。)
Range("C3:E22,H3:J22").Select
Selection.Font.ColorIndex = 2
Selection.Interior.ColorIndex = 2
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
' ここまでは、共通の動作
Range("A1").Select
ActiveCell.FormulaR1C1 = "20"
' 問題数に応じて、数字を変更
Range("C3:E22,H3:J22").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' 罫線を引く
Range("D3:E22,I3:J22").Select
Selection.Font.ColorIndex = 1
' 文字を黒くする
Range("C3:C22,H3:H22").Select
Selection.Interior.ColorIndex = 16
' セルをグレーにする
Rows("3:18").Select
Selection.RowHeight = 31.5
' セルの幅を指定
ActiveSheet.PageSetup.PrintArea = "$B$1:$K$25"
' 印刷範囲を指定
Range("U3:U42").Select
Selection.ClearContents
' 四線を消去
Range("D3:D4").Select
Calculate
' 再計算完了
宜しくお願いします。
また、このVBAは慣れている人から見ると何点くらいですか?(感覚で結構です)
No.7
- 回答日時:
質問のプログラムの各処理にがかかる時間を表示します。
最初のApplication.ScreenUpdatingは、ある場合と無い場合で違いを見てください。
特に時間がかかっている処理が無くてApplication.ScreenUpdatingのある場合が早いなら、何か全体を遅くしている表示関係の処理があるので、新たなブックに作り直すのが一番いいと思います。
'Application.ScreenUpdating = False '実行する場合としない場合でトータル時間の差を見る
Dim msg As String
Dim t As Single
Dim tt As Single
tt = Timer
t = Timer
Range("C3:E22,H3:J22").Select
Selection.Font.ColorIndex = 2
Selection.Interior.ColorIndex = 2
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
' ここまでは、共通の動作
msg = msg & "ここまでは、共通の動作=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Range("A1").Select
ActiveCell.FormulaR1C1 = "20"
' 問題数に応じて、数字を変更
msg = msg & "問題数に応じて、数字を変更=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Range("C3:E22,H3:J22").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' 罫線を引く
msg = msg & "罫線を引く=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Range("D3:E22,I3:J22").Select
Selection.Font.ColorIndex = 1
' 文字を黒くする
msg = msg & "文字を黒くする=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Range("C3:C22,H3:H22").Select
Selection.Interior.ColorIndex = 16
' セルをグレーにする
msg = msg & "セルをグレーにする=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Rows("3:18").Select
Selection.RowHeight = 31.5
' セルの幅を指定
msg = msg & "セルの幅を指定=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
ActiveSheet.PageSetup.PrintArea = "$B$1:$K$25"
' 印刷範囲を指定
msg = msg & "印刷範囲を指定=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Range("U3:U42").Select
Selection.ClearContents
' 四線を消去
msg = msg & "四線を消去=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Range("D3:D4").Select
Calculate
' 再計算完了
msg = msg & "再計算完了=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
msg = msg & "TotalTime=" & Format(Timer - tt, "0.00")
Application.ScreenUpdating = True
MsgBox msg
この回答への補足
教えていただいたものを新しいブックで試した結果、
両方とも差はありませんでした。
また、偏って時間がかかることもありませんでした。
自分が作ったサンプルをのせたので、見てもらえますか?
http://briefcase.yahoo.co.jp/bc/add0804/lst?.dir …
No.6
- 回答日時:
>MsgBox ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Count
>を試した結果、182でした。しかし、どれも必要な数式なので
>限界ですかね。
どんな数式かわかりませんが、182個程度ではそんなに時間はかからないと思います。
F8で、1ステップずつ実行してみた結果はどうだったのでしょうか?
納得されたならいいですが、たぶん原因は違う所にあると思います。
この回答への補足
F8をやってみた結果、どの過程でも1秒未満ですぐ動作しました。
しかし、全体を通して実行するとやはり10秒程度かかります。
(1つ1つの動作を合計しても2秒はかかりませんでした)
どうしてですかね?・・・
No.5
- 回答日時:
ANo.4です。
>確かに新しいブックだと1秒くらいでできました。
>ってことは遅い原因はエクセルの関数ってことですか?
F8で、1ステップずつ実行してみてください。
異常に時間がかかる部分がわかるはずです。
見えない大量のシェープがあるのかと思いましたが、35個程度ならたぶん問題なと思います。
最後の再計算が遅いのかもしれませんが、質問の内容から10秒もかかるような作業になるとは思えません。
ちなみに、
MsgBox ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Count
で、シート中の計算式のセルの個数がわかるので、極端に多いようならそのせいかもしれません。
>あと、「MsgBox ActiveSheet.Shapes.Count」やってみたら
>「35」って出ました。
>これはどういうことですか?
テキストボックスや図形などが35個あるということです。
表示関係が極端に遅くなったり、ファイルサイズが巨大になる原因になるようです。
35個程度なら問題はないと思いますが、覚えがないなら、下記で削除してください。
ActiveSheet.Shapes.SelectAll
Selection.Delete
表示関係で遅い場合、最初に
Application.ScreenUpdating = False
最後に
Application.ScreenUpdating = True
を入れると、速くなる場合もあります。
どうしても遅くなる理由がわからない場合は、新しいシートに作り直して見るというのが一番早いかもしれません。
長時間ありがうございました。
細かく教えていただいたおかげで、徐々にわかってきました。
最後に、
MsgBox ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Count
を試した結果、182でした。しかし、どれも必要な数式なので
限界ですかね。
No.4
- 回答日時:
ANo.3です。
>一般的にこの10秒弱の動作は遅いものなのでしょうか?
新しいブックに質問のプログラムだけだと、1秒はかからないと思います。(たぶん)
新しいブックで、質問のプログラムを動かしたらどうなりますか?
>Sub check()
>MsgBox Shapes.Count
>End Sub
>これやってみましたが、エラーになりました・・・
すみません、以下ではどうでしょうか?
MsgBox ActiveSheet.Shapes.Count
または、シート名がSheet1なら
MsgBox Worksheets("Sheet1").Shapes.Count
この回答への補足
確かに新しいブックだと1秒くらいでできました。
ってことは遅い原因はエクセルの関数ってことですか?
あと、「MsgBox ActiveSheet.Shapes.Count」やってみたら
「35」って出ました。
これはどういうことですか?
No.3ベストアンサー
- 回答日時:
根本的な話ですが・・・
罫線引くのにそんなに時間かかりますか?
試した限りでは、質問のプログラムは一瞬で終わりますが・・・
他にも計算式などがあるようなので、新規のブックで質問のプログラムだけを動かしても、秒単位で時間がかかりますか?
各処理(Range(??).Selectから次のRange(??).Selectまでの部分、再計算も1つとして)だけにして実行して、どの部分が一番時間がかかりますか?
または、質問のプログラムのコメントの位置でmsgboxすると、ちょうどいいかもしれません。
Range("C3:E22,H3:J22").Select
・・・
' ここまでは、共通の動作
MsgBox "ここまでは、共通の動作"
Range("A1").Select
ActiveCell.FormulaR1C1 = "20"
' 問題数に応じて、数字を変更
MsgBox "問題数に応じて、数字を変更"
Range("C3:E22,H3:J22").Select
・・・
' 四線を消去
MsgBox "四線を消去"
Range("D3:D4").Select
Calculate
' 再計算完了
MsgBox "再計算完了"
として、どの部分が一番時間がかかりますか?
もしかしたら、見えない何かがありませんか?
Sub check()
MsgBox Shapes.Count
End Sub
とかしたら、いくつ表示しますか?
いらないshapeがあるようなら、消してみてはどうでしょうか?
下は全部のシェープを消します。
Sub check()
Shapes.SelectAll
Selection.Delete
End Sub
その状態ではどれくらい時間がかかりますか?
この回答への補足
今、もう一度動作確認したら、10秒弱に縮まっていました。
なぜ短縮されたかわからないですが・・・(昨日の夜から何も変えてないのに)
一般的にこの10秒弱の動作は遅いものなのでしょうか?
あと、
Sub check()
MsgBox Shapes.Count
End Sub
これやってみましたが、エラーになりました・・・
No.2
- 回答日時:
>ちなみに、「根本的に書き換えてもっと早く動作する」なんてことはできるんですか?
仕様によります。
1.最初の初期化は必用なのか?
2.罫線の設定は必用なのか?
3.セル幅(高さ)の設定は必用なのか?
4.印刷範囲の設定は必用なのか?
5.四線を消去は必用なのか?
6.再計算は必用なのか?
無駄(不要)と思う部分を削除するか、別の方法で行うかの問題になります。
何が必用で、何が不要なのかがはっきりしないので何とも言えませんし、何度も実行するマクロでも無いとおもいます。
(1度実行すれば目的は達成される)
この回答への補足
まず、このマクロを使っているシートについて説明します。
英単語の小テスト(印刷して配布)を作るためのものです。
問題数は5問・10問・15問・20問の4パターン作る予定です。
問題はエクセルの関数でランダムに表示されるようになっています。
この前提で
1、初期化は問題数によって罫線や表示している問題数が違うため
必要です。
2、同上。
3、問題数によってセルの幅が変わる(1枚のシートに入るようにする)
ため必要。
4、問題数によって印刷範囲が変わるため、必要。
5、「四線」とは英語の4線のことですが、ワードアートのリンクで
表示されるようにしているため、解答を表示するときに必要。
6、再計算は、問題が勝手に変わらないように、手動で計算という
設定になっているため、問題数が変わったときに
シート内の関数を反映させるためには必要。
いちいち問題を作るのが面倒なので、いっそのことマクロでと
思ったのですが、動作が遅いのは仕方がないのですかね?
ちなみに修正したら15秒までは早くなりました。
宜しくお願いします。
No.1
- 回答日時:
短くするならこれだけ。
With Range("C3:E22,H3:J22")
.Font.ColorIndex = 2
.Interior.ColorIndex = 2
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
' ここまでは、共通の動作
Range("A1") = 20
' 問題数に応じて、数字を変更
With Range("C3:E22,H3:J22")
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Font.ColorIndex = 1
' 文字を黒くする
.Interior.ColorIndex = 16
' セルをグレーにする
End With
Rows("3:18").RowHeight = 31.5
' セルの幅を指定
' 罫線を引く
ActiveSheet.PageSetup.PrintArea = "$B$1:$K$25"
' 印刷範囲を指定
Range("U3:U42").ClearContents
' 四線を消去
Range("D3:D4").Select
Calculate
' 再計算完了
>このVBAは慣れている人から見ると何点くらいですか?(感覚で結構です)
記録マクロそのままみたいですから・・・
ありがとうございました!
動作時間が30秒→20秒に短縮されました!!
ちなみに、「根本的に書き換えてもっと早く動作する」
なんてことはできるんですか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) オートフィルタで抽出結果に 罫線をひく方法 1 2022/07/13 13:08
- Visual Basic(VBA) VBA 罫線について B列3行目から21行毎にデータがはいります。 データがはいったらデータが入った 6 2022/11/15 17:22
- Visual Basic(VBA) Worksheet_Change 4 2023/03/12 21:54
- Visual Basic(VBA) データのある範囲を選択するVBAについて 2 2022/09/03 00:20
- Visual Basic(VBA) マクロで最終行を取得してコピーしたい 3 2022/04/06 19:07
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
- Visual Basic(VBA) エクセルVBA ダブルクリックしたら色反転を指定したセルのみにしたい 2 2022/04/06 12:52
- その他(Microsoft Office) 選択行の列範囲に二重線を引く 3 2022/06/08 12:21
- Excel(エクセル) 表示形式、文字列セル(列)に数式を入力するには マクロ 1 2022/09/18 10:53
- マウス・キーボード Mouse without Bordersについて 2 2023/07/31 12:40
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Vba 実数および実数タイプの変...
-
Excelのマクロについて教えてく...
-
VBA レジストリの値の読み方に...
-
ExcelのVBAコードについて教え...
-
Excel マクロについての相談
-
Excel VBA 定義されたプロージ...
-
Vba SelStart、SelLen教えてく...
-
エクセルのマクロについて教え...
-
VBAに詳しい方教えてください。
-
VBAの質問になります メッセー...
-
ユーザーフォームに別シートか...
-
2つのマクロでチェックボックス...
-
VBA listBoxから
-
VBA初心者 Ctrl+での操作、ボタ...
-
VBA 複数条件の分岐処理の上手...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
左右の表のキー位置を合わせたい
-
VBAの質問になります Userform内で
-
Excelについて
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel VBA 定義されたプロージ...
-
Excel-VBAのmsgBox()の不思議
-
【VBA】マクロの入ったファイル...
-
VBA 複数条件の分岐処理の上手...
-
現在のブックを閉じないで、マ...
-
VBAで各列の"+"と"o"の合計数を...
-
VBAに詳しい方教えてください。
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
ユーザーフォームに別シートか...
-
エクセルのマクロについて教え...
-
ExcelVBA シート名を複数セルか...
-
エクセルのマクロについて教え...
-
VBA listBoxから
-
Excelのマクロについて教えてく...
-
エクセルのマクロについて教え...
おすすめ情報