【最大10000ポイント】当たる!!質問投稿キャンペーン!

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は慣れている人から見ると何点くらいですか?(感覚で結構です)

このQ&Aに関連する最新のQ&A

A 回答 (8件)

根本的な話ですが・・・


罫線引くのにそんなに時間かかりますか?
試した限りでは、質問のプログラムは一瞬で終わりますが・・・
他にも計算式などがあるようなので、新規のブックで質問のプログラムだけを動かしても、秒単位で時間がかかりますか?

各処理(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
これやってみましたが、エラーになりました・・・

補足日時:2008/02/23 10:28
    • good
    • 0

サンプルではそれほど時間がかからない(遅い所でも1秒前後)のですが、10秒(数秒)単位で時間がかかりますか?


細かい事は別にして、それほど高速化はできないみたいでした。
    • good
    • 0
この回答へのお礼

わかりました。
何度もありがとうございました。

お礼日時:2008/02/25 13:26

質問のプログラムの各処理にがかかる時間を表示します。


最初の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 …

補足日時:2008/02/24 22:13
    • good
    • 0

>MsgBox ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Count


>を試した結果、182でした。しかし、どれも必要な数式なので
>限界ですかね。
どんな数式かわかりませんが、182個程度ではそんなに時間はかからないと思います。
F8で、1ステップずつ実行してみた結果はどうだったのでしょうか?
納得されたならいいですが、たぶん原因は違う所にあると思います。

この回答への補足

F8をやってみた結果、どの過程でも1秒未満ですぐ動作しました。
しかし、全体を通して実行するとやはり10秒程度かかります。
(1つ1つの動作を合計しても2秒はかかりませんでした)
どうしてですかね?・・・

補足日時:2008/02/24 11:30
    • good
    • 0

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
を入れると、速くなる場合もあります。

どうしても遅くなる理由がわからない場合は、新しいシートに作り直して見るというのが一番早いかもしれません。
    • good
    • 0
この回答へのお礼

長時間ありがうございました。
細かく教えていただいたおかげで、徐々にわかってきました。
最後に、
MsgBox ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Count
を試した結果、182でした。しかし、どれも必要な数式なので
限界ですかね。

お礼日時:2008/02/23 22:20

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」って出ました。
これはどういうことですか?

補足日時:2008/02/23 12:41
    • good
    • 0

>ちなみに、「根本的に書き換えてもっと早く動作する」なんてことはできるんですか?



仕様によります。

1.最初の初期化は必用なのか?
2.罫線の設定は必用なのか?
3.セル幅(高さ)の設定は必用なのか?
4.印刷範囲の設定は必用なのか?
5.四線を消去は必用なのか?
6.再計算は必用なのか?

無駄(不要)と思う部分を削除するか、別の方法で行うかの問題になります。
何が必用で、何が不要なのかがはっきりしないので何とも言えませんし、何度も実行するマクロでも無いとおもいます。
(1度実行すれば目的は達成される)

この回答への補足

まず、このマクロを使っているシートについて説明します。
英単語の小テスト(印刷して配布)を作るためのものです。
問題数は5問・10問・15問・20問の4パターン作る予定です。
問題はエクセルの関数でランダムに表示されるようになっています。
この前提で

1、初期化は問題数によって罫線や表示している問題数が違うため
  必要です。
2、同上。
3、問題数によってセルの幅が変わる(1枚のシートに入るようにする)
  ため必要。
4、問題数によって印刷範囲が変わるため、必要。
5、「四線」とは英語の4線のことですが、ワードアートのリンクで
  表示されるようにしているため、解答を表示するときに必要。
6、再計算は、問題が勝手に変わらないように、手動で計算という
  設定になっているため、問題数が変わったときに
  シート内の関数を反映させるためには必要。

いちいち問題を作るのが面倒なので、いっそのことマクロでと
思ったのですが、動作が遅いのは仕方がないのですかね?
ちなみに修正したら15秒までは早くなりました。
宜しくお願いします。

補足日時:2008/02/22 23:40
    • good
    • 0

短くするならこれだけ。



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は慣れている人から見ると何点くらいですか?(感覚で結構です)

記録マクロそのままみたいですから・・・
    • good
    • 0
この回答へのお礼

ありがとうございました!
動作時間が30秒→20秒に短縮されました!!
ちなみに、「根本的に書き換えてもっと早く動作する」
なんてことはできるんですか?

お礼日時:2008/02/22 15:29

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QSub ***( ) と Private Sub ***( ) の違い

初歩的な質問で申し訳ありませんが・・・

自分でコードを書いていても、イベントが発生したりした時の処理で、コードのウィンドウで上のドロップダウンリストで選択できる時の処理などは自動的に[Private Sub Command1_Click( )]などと出てくるのでそのまま使っています。自分で別途プロシージャーを作成する時は[Sub ****( )]としています。
ですがその違いを理解しないまま、自分で作成する時は[Private Sub]ではなくて[Sub]を使っています。

Sub ***( ) と Private Sub ***( ) の違いは何なんでしょうか?
どなたか説明頂けませんか?
よろしくお願いします。

Aベストアンサー

「Sub」の部分にカーソルを置いて[F1]を押せばヘルプが起動します。
「指定項目」のところに「Public」と「Private」の説明がありますよ。
省略して「Sub hogehoge()」とした場合は「Public」とみなされます。

Publicは「すべてのモジュールから呼び出せるプロシージャ」ということになります。
Privateとすると「同じモジュールの中からしか呼び出せないプロシージャ」となります。

もしExcelをお持ちでしたらExcelのVBEで標準モジュールを追加し、「Sub Test1()」と「Private Sub Test2()」を作成してみてください。
そしてExcelの[ツール]-[マクロ]-[マクロ(Alt+F8)]でマクロ実行のダイアログを表示させてみるとわかります。
ここには実行できるプロシージャの一覧が表示されますが、Test1は表示されているけれどTest2は表示されません。
Test1はPublicで、Test2はPrivateだからです。

QEXCELファイルのカレントフォルダを取得するには?

EXCELファイルのカレントフォルダを取得するには?

C:\経理\予算.xls

D:\2005年度\予算.xls

EXCEL97ファイルがあります。

VBAで
  カレントフォルダ名
(C:\経理\,D:\2005年度\)
を取得する事は可能でしょうか?

CURDIRでは上手い方法が見つかりませんでした。

Aベストアンサー

こんばんは。
Excel97 でも、同じですね。以下で試してみてください。

Sub test()
'このブックのパス
a = ThisWorkbook.Path
'アクティブブックのパス
b = ActiveWorkbook.Path
'Excelで設定されたデフォルトパス
c = Application.DefaultFilePath
'カレントディレクトリ
d = CurDir
MsgBox "このブックのパス   : " & a & Chr(13) & _
   "アクティブブックのパス: " & b & Chr(13) & _
   "デフォルトパス    : " & c & Chr(13) & _
   "カレントディレクトリ : " & d & Chr(13)
End Sub

QEXCEL VBAで全選択範囲の解除

EXCEL VBAで
Cells.Select
と書くと、全セルが選択状態になりますが、
これを解除するには、どう書けばよいのでしょうか?

Aベストアンサー

その1
A1 など、適当なセルを選択する。
(回答#1と同じ)

その2
全選択する前の選択範囲に戻る。

全選択前に
変数 = Selection.Address で記憶

全選択後
Range(変数).Select で元の選択範囲を選択


人気Q&Aランキング