[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『2007更新後、マクロが遅くなった』（みかん）
いつも勉強させていただいております。 先日、会社のパソコンがオフィス2007に変わってしまいました。 それと同時に、マクロが非常に遅くなってしまい、今まで1分しかかからなかった作業が、 10分以上伸びてしまいました。
マシンの性能はPen4 3.2GHz 物理メモリ256MB*2枚 + 512MB*1枚（なぜか3枚） WindowsXP 32bit となっております。
マクロは以下のものを使っています。 Sub 行の折りたたみ()
Randomize
Application.ScreenUpdating = False
Application.Calculation = xlManual
Dim rw As Integer Dim i As Integer
With ActiveSheet
rw = .Cells(5000, 1).End(xlUp).Row
For i = 16 To rw Step 3
If Cells(i, 35) <= 0 Then
Rows(i).EntireRow.Hidden = True
Rows(i + 1).EntireRow.Hidden = True
Rows(i + 2).EntireRow.Hidden = True
End If
Next i
End With
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
http://kaiseki.ori.u-tokyo.ac.jp/~katukawa/hiki/?Excel+%26+VBA+tips
こちらを参考に、改良しては見たのですが、目に見えた効果を得られませんでした。 一日に10回ほど作業を繰り返すので、何かアドバイスがありましたらよろしくお願いいたします。
これで試してみてくらはい。
2007がどんな悪さをしているのかは見当がつきまへん。
Randomaize 再計算は必要なものでせうか？
（弥太郎）
'------------------------
Sub 行の折りたたみ2()
Dim rw As Long, i As Long, j As Long, x(), tbl
'Randomize
Application.ScreenUpdating = False
'Application.Calculation = xlManual
With ActiveSheet
rw = .Cells(Rows.Count, 1).End(xlUp).Row
tbl = .Cells(1, 35).Resize(rw)
For i = 16 To rw Step 3
If tbl(i, 1) <= 0 Then
ReDim Preserve x(j)
x(j) = .Cells(i, 1).Resize(3).Address(0, 0)
j = j + 1
If j > 20 Then
.Range(Join(x, ",")).EntireRow.Hidden = True
j = 0
End If
End If
Next i
If j > 0 Then .Range(Join(x, ",")).EntireRow.Hidden = True
End With
Application.ScreenUpdating = True
'Application.Calculation = xlAutomatic
End Sub
弥太郎様 返事が遅れてしまい申し訳ございません。
提示していただいたコードを使いましたら一気に作業が速くなりました！ 大変ありがとうございました。
恥を承知で、上記のコードと合わせて使っているものがありまして、こちらも時間がかかってしまいます。
Sub 折りたたみ()
Randomize
Application.ScreenUpdating = False
'Application.Calculation = xlManual
Dim rw As Integer Dim i As Integer
rw = ActiveSheet.Cells(2000, 2).End(xlUp).Row
For i = 18 To rw Step 3
Rows(i).EntireRow.Hidden = True
Next i
Application.ScreenUpdating = True
'Application.Calculation = xlAutomatic
End Sub
やりたいことは、3行ずつ行を折りたたむのですが、すでに非表示の行まで折りたたもうとするため、 非効率的なのです。 非表示の行を無視して、繰り返し動作をさせる方法はないでしょうか？ よろしくお願い申し上げます。 （みかん）
こういう事でっか？それとも表示されているデータを３行ごとに非表示にするという
事？
（弥太郎）
'---------------------
Sub 折りたたみ3()
Dim i As Long, rw As Long, j As Long, x()
Randomize
Application.ScreenUpdating = False
'Application.Calculation = xlManual
rw = ActiveSheet.Cells(2000, 2).End(xlUp).Row
For i = 18 To rw Step 3
ReDim Preserve x(j)
x(j) = Cells(i, 1).Address(0, 0)
j = j + 1
If j = 40 Then
Range(Join(x, ",")).EntireRow.Hidden = True
j = 0
End If
Next i
If j > 0 Then Range(Join(x, ",")).EntireRow.Hidden = True
Application.ScreenUpdating = True
'Application.Calculation = xlAutomatic
End Sub
10000 行をHide しても2秒なので、いらないんじゃないかと思いましたが それでも条件判定をした方が早くなりましたね。 下記のコードで全部開いた状態と、全部閉じた状態を比較したら10分の１ 程度の時間になりました。
Sub 折りたたみ()
Application.ScreenUpdating = False
Dim rw As Integer
Dim i As Integer
rw = ActiveSheet.Cells(2000, 2).End(xlUp).Row
For i = 18 To rw Step 3
If Rows(i).EntireRow.Hidden = False Then
Rows(i).EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True
End Sub
(Mook)
なるほろ～、↑の方がよほど速い。 みかんはん、こっちでいきまひょ。 （弥太郎）
お返事が遅くなり大変申し訳ございません。 今、Mook様のコードを試させていただいたところ、以前より格段に処理がはやくなりました。 ありがとうございます。
エクセルに限らず、2007にしてからアウトルックもワードも文字入力時に遅延が見られ、文字の子音が抜けることが多くなりました…。 詳しいことはわかりませんが、スペック不足とのことなので、次回リース更新まで我慢したいと思います。
弥太郎様 Mook様 大変ありがとうございました。 (みかん)
一応、解決されたようですが・・・ [[20090309222324]]『カメラ機能』への書き込みを見ると、 カメラ機能が邪魔していたようですね。 ところで、↑のいくつかのコードは、10分のものが数秒になったように読めたのですが 実のところそこまでの効果はなかったということでよろしいですか? 回答者の皆さんには失礼な書き方ですがお許しを・・・ (Hatch)
いえ、かなりの改善が見られました。 10分かかっていたものが、20秒そこそこで終了するようになりました。 ただ、カメラ機能を切った場合さらに早くなったのでご提示の質問スレで報告させていただきました。
実はこのスレッド以外にも複数マクロを使用していまして、そちらも軒並み遅くなってしまっていたのです。 ブック自体は違うのですが、同時に複数開くことが多く、開きすぎが原因だとあきらめておりましたが 先ほど何気なく覗いたところで「カメラ機能が原因だったんだ」ということになりました。 こちらの質問方法も悪かったと現在反省しております。 申し訳ございませんでした。
今では比較できませんが、2003のころよりもこちらで教えていただいたコードのほうが圧倒的に 速度が速いことはお伝えしておきます。
わざわざありがとうございました。 （みかん）
実のところ、最初にみかんさんが書いておられるコードを、5000行ほどのいい加減なデータで 試しても数秒(体感的に約1～2秒)で終わったのです。 確かに弥太郎さんのコードでは2秒ほどが1秒ほどで終わるような感じで早いのはわかりました。 (この時間はいい加減な体感速度です) でも、10分が20秒となるほど効果があるように私には思えなかったので、上のような書き込みをしました。 返答をいただきありがとうございました。 (Hatch)
おそらく環境が最初に質問したときと違っていた（開いているブック数、その他常駐ソフトの有無）も大きく関係していると思います。 当時、2007移行後2日目でしたので検証不足も多々ありました。 一分ほどかかる、といった最初の書き込みも前任者からの引継ぎの合間にデータ量そのものも減って おりますし、効率的な関数に置き換え（すべて手作業の足し算を配列に直す等）たりしていました ので1分から現在の20秒 10秒においても体感と上記のような要因が大きく関与していると思われます。 最初から私の方に非がありますので、回答者様及びこちらを参考になさっている方やHatch様には申し訳ないと思っております。
そもそも職場の環境自体も100kB超のブック5冊（？）とOutlook、会社専用アプリケーションに ListCreatorを同時起動させているのでパソコンの性能から見ても明らかにスペック不足なのは 認識しております。
お騒がせしてしまい申し訳ございませんでした。 （みかん）
新しいスレッドを立てることでもないと思いましたので、上げさせていただきます。 実は弥太郎様に教えていただいたコードに変更を加えようとしたのですが、どこがどうなっているの かわからないので教えを請いに参りました。
順を追って説明いたしますと、教えていただきたいコードより条件が一つ追加されました。 以前はAI列（35列目）の16行目から3行置きに「0以下の場合その行と下2行を折りたたむ」という 処理でしたが、今度は36列目も3行置きに判定するようにしていただきたかったのです。
まとめると 「35列目の16行目から3行置きに0以下だった場合」 「もしくは35列目が16行から3行置きに0以下、且つ36列目の同じ行が0だった場合」 折りたたむ処理をしたいのです。
自分でも理解しながら変更していきたいので、面倒かもしれませんが一つずつ教えていただけたら と思います。
Sub 行の折りたたみ2() ですが
rw = .Cells(Rows.Count, 1).End(xlUp).Row
~~~~~~~~~~~~
①行の値を取得しているというのはわかるのですが、上記の場合.Cells(65536,1)とは異なる性質なのでしょうか？
tbl = .Cells(1, 35).Resize(rw)
~~~~~~~~~~
②選択？「範囲を広げる」というのは知っているのですが、この場合
どのような意味を持つのでしょうか？
For i = 16 To rw Step 3
If tbl(i, 1) <= 0 Then
~~~~~~~~~
③②と同じく、iがどの位置にくるのかわかりません。。。
条件がどのような状態を指しているのですか？
ReDim Preserve x(j)
x(j) = .Cells(i, 1).Resize(3).Address(0, 0)
j = j + 1
If j > 20 Then
.Range(Join(x, ",")).EntireRow.Hidden = True
j = 0
End If
End If
Next i
この部分は何となく、動的配列Xが、X(0)～X(20)まで記憶し、21までいったら行を隠してX(0)に
戻りなさいというのはわかるのですが、
.Range(Join(x, ","))
~~~~~~~~~~~~
④この場合、.Cells(i, 1)Resize(3).Address(0, 0)が代入されるところまではわかります。
このAddress(0, 0)はただのAddressだけではない理由は範囲だからですか？
ただのAddressだけだとA1:B2がA1だけになってしまうとか。。。？
それで、以下の場合それぞれ
i=19,22,25で条件に合った場合
.Range(Join(x, ","))=.Range(AI19:AI21,AI22:AI24,AI25:AI28)
となるのでしょうか？
'---------------------
それともうひとつ質問がありまして、色がついたセルを数えたかったので、 こちらの質問ボードで検索したものをくっつけて使っているものがあるのですが、行を隠すと#Value! のエラーが出てしまいます。 セルの編集（F2)を押して確定することですぐに戻るのですが回避する方法がありましたら教えてください。
Function FCC(adrs As Range, ccel As Range) 'FCC(範囲,数えたい色のセルまたは色番号）
cnt = 0
colr = ccel.Interior.ColorIndex
For Each ad In adrs
cnt = cnt + IIf(ad.Interior.ColorIndex = colr, 1, 0)
Next
FCC = cnt
End Function
わからないことばかりで申し訳ございませんがよろしくお願い致します。 (みかん)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.