Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4642 / 13644 ツリー ←次へ | 前へ→

【55442】Do Loop処理の負荷軽減策を教えてください 新参者 08/5/4(日) 15:35 質問[未読]
【55443】Re:Do Loop処理の負荷軽減策を教えてくださ... Hirofumi 08/5/4(日) 16:16 回答[未読]
【55445】Re:Do Loop処理の負荷軽減策を教えてくださ... 新参者 08/5/4(日) 17:00 発言[未読]
【55447】Re:Do Loop処理の負荷軽減策を教えてくださ... Hirofumi 08/5/4(日) 17:35 発言[未読]
【55449】Re:Do Loop処理の負荷軽減策を教えてくださ... Hirofumi 08/5/4(日) 18:36 発言[未読]

【55442】Do Loop処理の負荷軽減策を教えてください
質問  新参者  - 08/5/4(日) 15:35 -

引用なし
パスワード
   はじめまして。お世話になります。

久しぶりにExcelVBAでモジュールを組んでいます。

ある4桁の数を桁ごとに集計するモジュールを組んでいます。
実行結果は思ったとおりに反映されますが、
どうも動作が軽くありません。
1500程度の集計で約11秒ほどかかってしまいます。
PC環境については
CPU:Pen4 2.0GHz 
RAM:512MB
です。
もしかしたらこんなものでしょうか?

どこか動作の負荷を軽減する工夫する余地があれば
教えて頂けないでしょうか。

よろしくお願いいたします。

(以下モジュール)

Sub ResetList()
  Dim r As Integer
  r = 1
  Do Until Cells(r, 1) = ""
    Cells(r, 4) = Left(Cells(r, 3), 1)
    Cells(r, 5) = Mid(Cells(r, 3), 2, 1)
    Cells(r, 6) = Mid(Cells(r, 3), 3, 1)
    Cells(r, 7) = Right(Cells(r, 3), 1)
  r = r + 1
  Loop
  MsgBox "リストのリセットが完了しました!!"
End Sub

【55443】Re:Do Loop処理の負荷軽減策を教えてくだ...
回答  Hirofumi  - 08/5/4(日) 16:16 -

引用なし
パスワード
   セルを1つづつ読み書きする事が非常に遅いので、こんな事をすると少しは速く成ると思います
全データを配列に取得し、其れを使って確保した結果出力用配列に処理を書き込みます
集計処理が終わったら結果用配列をシートに出力しています

Option Explicit

Sub ResetList2()

  Dim i As Long
  Dim lngRows As Long
  Dim rngList As Range
  Dim vntData As Variant
  Dim vntResult As Variant
  
  'データの先頭を基準とする
  Set rngList = Cells(1, 1)
  
  With rngList
    'データ行数を取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
    If lngRows <= 1 And .Value = "" Then
      Set rngList = Nothing
      Exit Sub
    End If
    'データを配列に取得
    vntData = .Offset(, 2).Resize(lngRows + 1).Value
  End With
  
  '出力用配列を確保
  ReDim vntResult(1 To lngRows, 1 To 4)
  
  'データ全行に就いて繰り返し
  For i = 1 To lngRows
    vntResult(i, 1) = Left(vntData(i, 1), 1)
    vntResult(i, 2) = Mid(vntData(i, 1), 2, 1)
    vntResult(i, 3) = Mid(vntData(i, 1), 3, 1)
    vntResult(i, 4) = Right(vntData(i, 1), 1)
  Next i
        
  '集計結果を出力
  rngList.Offset(, 3).Resize(lngRows, 4).Value = vntResult
  
  Set rngList = Nothing
  
  MsgBox "リストのリセットが完了しました!!"
  
End Sub

【55445】Re:Do Loop処理の負荷軽減策を教えてくだ...
発言  新参者  - 08/5/4(日) 17:00 -

引用なし
パスワード
   Hirofumi様

ご回答有難うございました。

格段に処理が早くなりました!
感謝いたします!

Hirofumiさんは普段どのような思想で
モジュールを組むのでしょうか?

もしよければ教えて頂けないでしょうか。
今後の参考になればと思います。
(図々しいお願いですいません)

▼Hirofumi さん:
>セルを1つづつ読み書きする事が非常に遅いので、こんな事をすると少しは速く成ると思います
>全データを配列に取得し、其れを使って確保した結果出力用配列に処理を書き込みます
>集計処理が終わったら結果用配列をシートに出力しています
>
>Option Explicit
>
>Sub ResetList2()
>
>  Dim i As Long
>  Dim lngRows As Long
>  Dim rngList As Range
>  Dim vntData As Variant
>  Dim vntResult As Variant
>  
>  'データの先頭を基準とする
>  Set rngList = Cells(1, 1)
>  
>  With rngList
>    'データ行数を取得
>    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
>    If lngRows <= 1 And .Value = "" Then
>      Set rngList = Nothing
>      Exit Sub
>    End If
>    'データを配列に取得
>    vntData = .Offset(, 2).Resize(lngRows + 1).Value
>  End With
>  
>  '出力用配列を確保
>  ReDim vntResult(1 To lngRows, 1 To 4)
>  
>  'データ全行に就いて繰り返し
>  For i = 1 To lngRows
>    vntResult(i, 1) = Left(vntData(i, 1), 1)
>    vntResult(i, 2) = Mid(vntData(i, 1), 2, 1)
>    vntResult(i, 3) = Mid(vntData(i, 1), 3, 1)
>    vntResult(i, 4) = Right(vntData(i, 1), 1)
>  Next i
>        
>  '集計結果を出力
>  rngList.Offset(, 3).Resize(lngRows, 4).Value = vntResult
>  
>  Set rngList = Nothing
>  
>  MsgBox "リストのリセットが完了しました!!"
>  
>End Sub

【55447】Re:Do Loop処理の負荷軽減策を教えてくだ...
発言  Hirofumi  - 08/5/4(日) 17:35 -

引用なし
パスワード
   >Hirofumiさんは普段どのような思想で
>モジュールを組むのでしょうか?
>
>もしよければ教えて頂けないでしょうか。
>今後の参考になればと思います。
>(図々しいお願いですいません)

特に思想と言うほどの物は持っていませんが、
 一応、私なりにコードの生産性(転用性?)、標準化を考慮して書いている積りです
 処理的に同じ、若しくは殆ど同じですが、入力側、出力側のListの位置が違う
また、Keyと成る列に位置が違うと言う事が多々有ります
 その為に、コードを書き直す、修正する等で手間が掛りバグも必至と思っています
 因って、範囲の位置を指定するのに、シートの絶対位置で全てを行わず
入力側、出力側の基準セル位置を決めて、位置が必要な場合、
概ねこの位置からのOffset値で指定しています
 また、Keyと成る列の位置等も、基準セル位置からの列Offsetを定数とし設定する様にしています
 この様にすれば、入力側、出力側のListの位置が変更に成っても、
コードそのものをいじらすに、基準セル位置の変更だけで済みますし
Keyと成る列の位置が変更になっても、定数の値のみの変更で済みます

 また、Excelのマクロは大抵、入力側のListが有り、
出力側のList有る様な仕様が多いと思っています
 因って、マクロの書き方も、前半部は、各位置等の定数指定、変数宣言、
入力側、出力側の基準セル位置の指定、各Listの緒言取得を定型的に行い
中盤部で、処理、出力を行い、後半部で終了処理を定型的に行っていますし
 また、使っている変数名も概ね決めて使って居ます

【55449】Re:Do Loop処理の負荷軽減策を教えてくだ...
発言  Hirofumi  - 08/5/4(日) 18:36 -

引用なし
パスワード
   そう、事例で示すと
 新参者さんのコードは、データがA1から下に有ることを想定して書いていますよね
もし、このデータがB2以下で始まって居たらどの様に修正しますか?

>ある4桁の数を桁ごとに集計するモジュールを組んでいます。
>実行結果は思ったとおりに反映されますが、
>
>Sub ResetList()
>  Dim r As Integer
>  r = 1
>  Do Until Cells(r, 1) = ""
>    Cells(r, 4) = Left(Cells(r, 3), 1)
>    Cells(r, 5) = Mid(Cells(r, 3), 2, 1)
>    Cells(r, 6) = Mid(Cells(r, 3), 3, 1)
>    Cells(r, 7) = Right(Cells(r, 3), 1)
>  r = r + 1
>  Loop
>  MsgBox "リストのリセットが完了しました!!"
>End Sub

たった此れだけの行数でも修正箇所は、結構あると思います

Sub ResetList2()

  Dim i As Long
  Dim lngRows As Long
  Dim rngList As Range
  Dim vntData As Variant
  Dim vntResult As Variant
  
  'データの先頭を基準とする
  Set rngList = Cells(1, 1)
  
  With rngList
    'データ行数を取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
    If lngRows <= 1 And .Value = "" Then
      Set rngList = Nothing
      Exit Sub
    End If
    'データを配列に取得
    vntData = .Offset(, 2).Resize(lngRows + 1).Value
  End With
  
  '出力用配列を確保
  ReDim vntResult(1 To lngRows, 1 To 4)
  
  'データ全行に就いて繰り返し
  For i = 1 To lngRows
    vntResult(i, 1) = Left(vntData(i, 1), 1)
    vntResult(i, 2) = Mid(vntData(i, 1), 2, 1)
    vntResult(i, 3) = Mid(vntData(i, 1), 3, 1)
    vntResult(i, 4) = Right(vntData(i, 1), 1)
  Next i
        
  '集計結果を出力
  rngList.Offset(, 3).Resize(lngRows, 4).Value = vntResult
  
  Set rngList = Nothing
  
  MsgBox "リストのリセットが完了しました!!"
  
End Sub

しかし、上記のコードでは、

  'データの先頭を基準とする
  Set rngList = Cells(1, 1)



  'データの先頭を基準とする
  Set rngList = Cells(2, 2)

とすれば済みます

4642 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free