プロが教えるわが家の防犯対策術!

単純な1行おきに色を付けるマクロなのですが、
実行すると400件位は処理するのですが、そこで固まってしまいます。
1.5MB のデータで15000件位あります。
タスクマネージャのCPU使用率は100%になってます。
どのように対応すればよいか、ご教授お願いします。

A 回答 (10件)

こんばんは。

KenKen_SP です。

条件付き書式を使えば?

Sub Sample1()

  ' テストデータをセット
  Cells.Delete
  Range("A1:A15000").Value = "TestData"

  MsgBox "条件付き書式で1行置きにセルを着色します", vbInformation

  Application.ScreenUpdating = False
  ' 条件付き書式をセット
  ActiveSheet.Cells.FormatConditions.Delete
  With ActiveSheet.UsedRange.EntireRow.FormatConditions
    With .Add(Type:=xlExpression, Formula1:="=(MOD(ROW(),2)=0)")
      .Interior.ColorIndex = 34
    End With
    With .Add(Type:=xlExpression, Formula1:="=(MOD(ROW(),2)>0)")
      .Interior.ColorIndex = 36
    End With
  End With
  Application.ScreenUpdating = True

End Sub

ご提示のコードで言えば、一行ずつ色を変えてくのではなく、

  1. 一度最終セルまでの全体を色1で着色
  2. For~Next を使って 1行飛ばしで色2で着色

とすると結果は同じでも、低速な Range オブジェクトへのアクセス数が約半分
に減らせますよ。

Sub Sample2()

  Dim lLastRownum As Long
  Dim i      As Long
  
  ' テストデータをセット
  Cells.Delete
  Range("A1:A15000").Value = "TestData"
  
  MsgBox "全体を着色してから1行置きに着色し直します", vbInformation
  
  Application.ScreenUpdating = False
  lLastRownum = Cells(Rows.Count, "A").End(xlUp).Row
  Range("A1", Cells(lLastRownum, "A")).EntireRow.Interior.ColorIndex = 34
  For i = 1 To lLastRownum Step 2
    Rows(i).Interior.ColorIndex = 36
  Next i
  Application.ScreenUpdating = True

End Sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます。柔軟な発想力見事です。恐れ入りました。

お礼日時:2006/11/30 20:25

#01です。

マクロのUPありがとうございました。
少し目先を変えてみました。15,000行でも一瞬で終わると思います。
ただし行数が1行しか無いときなどのエラー処理は入れていません。

Private Sub CommandButton1_Click()
Dim IRO_1 As Integer
Dim IRO_2 As Integer

 IRO_1 = TextBox1.Text
 IRO_2 = TextBox2.Text
 Range("A1").Interior.ColorIndex = IRO_2
 Range("A2").Interior.ColorIndex = IRO_1
 Range("A1:A2").Copy
 Rows("1:" & Range("A65536").End(xlUp).Row).Select
 Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
  SkipBlanks:=False, Transpose:=False
 Application.CutCopyMode = False
End Sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます。色々な手法がありますね。条件付書式初めて知りました。勉強になります。

お礼日時:2006/11/30 20:31

こんばんは。



原因は、Select。
行Select,色付け、行Select,色づけ・・・
おい、おい、という感じでCPUが慌てふためいて・(^^;;;
今回のような場合はSelectは必要ありませんので外しましょう。
 
--------------------------------------------------------
Private Sub CommandButton1_Click()

 Dim IRO_1 As Variant
 Dim IRO_2 As Variant
 Dim i As Integer
 Dim WK_RESULT As Integer

 IRO_1 = Val(TextBox1.Text)
 IRO_2 = Val(TextBox2.Text)

 i = 1

 Do While Cells(i, 1) <> ""

   WK_RESULT = i Mod 2

   If WK_RESULT = 0 Then
     Rows(i).Interior.ColorIndex = IRO_1
   Else
     Rows(i).Interior.ColorIndex = IRO_2
   End If

   i = i + 1

 Loop

End Sub
-------------------------------------------------------

これに限らず、不要なSelectはしないようにしましょう。
以上です。
  
    • good
    • 0
この回答へのお礼

回答ありがとうございます。最小限での修正、的確なアドバイス、感服いたしました。

お礼日時:2006/11/30 20:22

こんばんは。



>タスクマネージャのCPU使用率は100%になってます。

あながち、CPU使用率の一瞬100%になる場合は気にしなくてよいのですが、ブックのOLEやDDEの問題とかありますので、ずっと、そのままになってしまう場合は、そういう他とつながっているものを疑ってよいと思います。

また、Excel2000 ということですと、配列数式の累計演算セル数の約5,500個を越える部分に、エラーを起こす元があるようですから、数式には気をつけたほうがよいです。また同様に、書式も、累計数の問題でエラーがありますから、このような、一個ずつ色づけする方法は、あまり芳しくありません。まとめて色を塗るというのが鉄則です。しかし、それでも、1.5M ファイルサイズがあって、なお、列全体に色をつけてしまうというのは、書式を使って範囲を広げることですから、全体的なワークシートの使い方の考え方としては無理があります。

とはいえ、このような場合は、AutoFilter などを使うと良いようです。なぜか、負担が少ないようです。ともかく、以下で試してみてください。

なお、変数 i  は、Long型です。

'---------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim Iro_1 As Integer
Dim Iro_2 As Integer
Dim i As Long
On Error GoTo ErrHandler
Iro_1 = TextBox1.Text
Iro_2 = TextBox2.Text
Application.ScreenUpdating = False
With ActiveSheet
  i = Range("A65536").End(xlUp).Row
  With .Range(.Cells(1, 256), .Cells(i, 256))
    .FormulaLocal = "=MOD(ROW(),2)"
    .AutoFilter Field:=1, Criteria1:="0"
    .EntireRow.SpecialCells(xlCellTypeVisible).Interior.ColorIndex = Iro_1
    .AutoFilter Field:=1, Criteria1:="1"
    .EntireRow.SpecialCells(xlCellTypeVisible).Interior.ColorIndex = Iro_2
    .AutoFilter
    .ClearContents
  End With
End With
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
  MsgBox Err.Number & ": " & Err.Description
End Sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます。コピーさせてもらい実行したのですがちょっと上手くいきませんでした・・・ちょっと間違えたかもしれませんが・・貴重なご意見参考にさせてもらいます。

お礼日時:2006/11/30 20:28

Ano4です。


(;¬_¬) ぁ ゃι ぃ
を取り消します。(^^ゞ

実際にソースを貼り付けて実行して見ました。
IRO_1 = 2
IRO_2 = 4
に変更して、

  i = i + 1
  DoEvents
Loop
End
End Sub
とLoopの前に DoEvents と End Subの前に End を付けて実行しました。

問題なく1行置きに色がつきましたねぇ・・・
但し、3000行までで、700Hzの5年ほど前のノートPCです。

という事で、ソースは問題ありません。
という事は、メモリは大丈夫ですか?いくつを積んでいますか?
    • good
    • 0
この回答へのお礼

回答ありがとうございます。多くの方に教えていただき、無事解決致しました。

お礼日時:2006/11/30 20:19

1セルごとに、同じにしろ、違うにしろ、条件付書式を多数セルに設定すると、メモリを食うというのを読んだことがあります。

上限もあったように記憶します。
小生はInsideエクセルは不確かですが、1セルもRangeで1つですが、それに対O応する書式をメモリに網羅して記憶するはずで、記憶単位はRangeだと思うのです。
(1)なるべく同じ条件付き書式なら、セル範囲で設定する。
(2)データ内容の変化に瞬時にたいおうできないが、書式をV条件をVBAで切り分け、対応した書式をVBAで設定するのはどうでしょう。
(3)(2)を進めてChangeイベントでデータの変化を捉えたとき
(2)と同じ判別と書式設定のルーチンを通す
のはどうでしょう。
    • good
    • 0
この回答へのお礼

回答ありがとうございます。多くの方に教えていただき、無事解決致しました。

お礼日時:2006/11/30 20:19

ここはソース公開が手っ取り早いですね。


自分も他の方もソースが(;¬_¬) ぁ ゃι ぃ
と睨んでいます。

ソースに問題が無ければ、別の方向に目が向けれますしね。

この回答への補足

ANO.1にソースを貼り付けて見ましたのでお願いします。

補足日時:2006/11/29 22:15
    • good
    • 0

一番良いのは最新のマシンに


替える事でしょうか?

CPUが100%超えているという事ですよね。

私もExcelを使っていますが、私事で言えば
自宅の2000と会社の2003では機能が違うし、

自宅のADSLと会社のCATVでは速度も違います。

私は判っている(つもりです)ので
もし、自宅が固まっても問題ありません。
(判ってます・・PC古いし、速度も出ないし・・
固まった場合の対処とか・・))

固まるのがいやであれば、とりあえず一番いい方法は
最新マシンを購入でしょうか。

私もお金さえあれば、最新PC購入が夢ですね。
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
EXCEL2000なのですが、会社のPCで結構新しいものなのですが・・・
何回か実行して385件目とか392、400位とか400件前後で必ず固まるんです。件数少ない時は正常に終わっていたはずなんですが。

お礼日時:2006/11/29 22:23

>単純な1行おきに色を付けるマクロなのですが、


条件付き書式を使うとか、2行選択して書式のコピーしたほうが早い気がしますが...

>実行すると400件位は処理するのですが、そこで固まってしまいます。
マクロのコードが分らないと適切な回答は付きませんよ。
現状で考えられるのは、変数が多すぎるとか、ループの仕方に問題があるとかですが...

>1.5MB のデータで15000件位あります。
>タスクマネージャのCPU使用率は100%になってます。
とりあえずでなら、ブックをコピーして500件位で試してみて同じ症状がでるか確認してください。
そこででないならメモリ容量の問題の可能性が高いです。
逆に同じ症状があるなら、マクロのコードに無駄・無理があります。
その場合は補足にでもコードを公開して確認できるようにしてください。

この回答への補足

ANO.1にソースを貼り付けて見ましたのでお願いします。

補足日時:2006/11/29 22:12
    • good
    • 0
この回答へのお礼

回答ありがとうございます。多くの方に教えていただき、無事解決致しました。

お礼日時:2006/11/30 20:20

「固まる」とありますがCPU使用率が100%だとすると固まっている(フリーズしている)のではなくループしている可能性もありますね。



ループの終了判定にIntegerの変数を使用して、桁落ちしたりしていませんか?
マクロを補足に掲載してみれば具体的な回答が得られるかもしれませんよ。

なお1行おきに色を付けるだけなら条件付き書式で「=MOD(ROW(),2)=0」という式を使って、書式で背景色を指定すれ方法でも実現できます。

この回答への補足

フォームを使っていてボタンを押下するとこんな感じなのですが・・・

Private Sub CommandButton1_Click()
Dim IRO_1 As Integer
Dim IRO_2 As Integer
Dim i As Integer
IRO_1 = TextBox1.Text
IRO_2 = TextBox2.Text
i = 1

--------Do While ActiveSheet.Cells(i, 1) <> ""
-----------WK_RESULT = i Mod 2
-----------If WK_RESULT = 0 Then
--------------ActiveSheet.Rows(i).Select
-----------------With Selection.Interior
----------------------.ColorIndex = IRO_1
----------------------.Pattern = xlSolid
----------------------.PatternColorIndex = xlAutomatic
-----------------End With
-----------Else
--------------ActiveSheet.Rows(i).Select
-----------------With Selection.Interior
----------------------.ColorIndex = IRO_2
----------------------.Pattern = xlSolid
----------------------.PatternColorIndex = xlAutomatic
-----------------End With
-----------End If
-----------i = i + 1

--------Loop

End Sub

補足日時:2006/11/29 22:06
    • good
    • 0

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