Excel VBA質問箱 IV

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

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


20258 / 76732 ←次へ | 前へ→

【61896】Re:消去作業について
回答  Hirofumi  - 09/6/11(木) 8:50 -

引用なし
パスワード
   ▼YOUSUKE さん:
>Hirofumi さんの言うとおりに、教えていただいた、コマンドでものすごく早くなりました。数倍、体感的には10倍くらい早い感じがします。ありがとうございます。
>このコマンドなんですが、整列してまとめて、消去するだけでここまで早くなるも物なのでしょうか? 配列など巧みに使用されていますが、この辺も速度アップに関係しているのでしょうか?

Excelの行列の削除は、前のレスで書いた様に纏めて(特に後ろにデータが無い様にして)
削除する方がが速く成ると思います

また、基本的にセルに対する読み書きは、1つづつ行うと変数に対する其れと違い
非常に時間が掛かります
因って、在るセル範囲に対する読み出しを行う場合、一括して配列変数に読み込んで
この配列変数の値を使います
また、セル範囲に書き出す場合、配列変数を確保して此れに結果を書き込んだ上で
配列変数をセル範囲に出力した方が一般的に速く成ると思います

しかし、配列変数の使い方自体は難しい事は無いのですが?
配列変数はリソースを食いますので、無暗に巨大な配列変数を使うと帰ってパホーマンスに
影響を与えると思います
ですので、配列変数を使う場合、配列変数のサイズを考慮して使用するのが効果的だと思います

尚、今回は使用していませんが

  '画面更新を停止
  Application.ScreenUpdating = False
  
  '画面更新を再開
  Application.ScreenUpdating = True

を併用しても効果が有ると思います

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim lngRows As Long    'データ行数
  Dim lngCount As Long   '削除数
  Dim vntSheets As Variant '対象シート名の一覧
  Dim vntTop As Variant   '対象シートのデータ先頭行
  Dim vntColumns As Variant '対象シートの最終データ列位置
  Dim lngDelete() As Long   '削除行のFlag
  Dim vntKeys1 As Variant
  Dim vntKeys2 As Variant
  
  vntSheets = Array("D1", "D2", "D3", "D4", "D5", "D6")
  vntTop = Array(3, 3, 3, 3, 3, 1)
  vntColumns = Array(130, 130, 130, 130, 130, 130)
  
  lngRows = 800
  
  'D1シートに就いて
  With Worksheets(vntSheets(0))
    '130列のデータを配列に取得
    vntKeys1 = .Range(.Cells(vntTop(0), 130), _
            .Cells(vntTop(0) + lngRows - 1, 130)).Value
    '1列のデータを配列に取得
    vntKeys2 = .Range(.Cells(vntTop(0), 1), _
            .Cells(vntTop(0) + lngRows - 1, 1)).Value
  End With
  '削除Flag用の配列を確保
  ReDim lngDelete(1 To lngRows, 1 To 1)
  
  '削除Flagを作成
  For i = 1 To lngRows
    If vntKeys1(i, 1) = "" Or vntKeys2(i, 1) < 50 Then
      lngDelete(i, 1) = 1
      lngCount = lngCount + 1
    End If
  Next i
  
  '画面更新を停止
  Application.ScreenUpdating = False '★追加
    
  '削除する行が在るなら
  If lngCount > 0 Then
    'シート一覧に基いて
    For i = 0 To UBound(vntSheets)
      With Worksheets(vntSheets(i))
        '最終列の後ろに削除Flagを出力
        .Cells(vntTop(i), vntColumns(i) + 1).Resize(lngRows).Value = lngDelete
        '削除FlagをKeyとしてListを整列
        .Cells(vntTop(i), 1).Resize(lngRows, vntColumns(i) + 1).Sort _
            key1:=.Cells(vntTop(i), vntColumns(i) + 1), Order1:=xlAscending, _
            Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom, SortMethod:=xlStroke
        '削除Flagが1の行を削除
        .Cells(vntTop(i) + lngRows - lngCount, 1).Resize(lngCount).EntireRow.Delete
        '削除Flagを削除
        .Cells(vntTop(i), vntColumns(i) + 1).EntireColumn.Delete
      End With
    Next i
  End If
  
  '画面更新を再開
  Application.ScreenUpdating = True '★追加

  MsgBox "処理が完了しました", vbInformation '★追加
  
End Sub
0 hits

【61871】消去作業について YOUSUKE 09/6/10(水) 1:05 質問
【61873】Re:消去作業について Hirofumi 09/6/10(水) 8:09 発言
【61876】Re:消去作業について Hirofumi 09/6/10(水) 9:47 回答
【61882】Re:消去作業について YOUSUKE 09/6/10(水) 13:51 お礼
【61895】Re:消去作業について YOUSUKE 09/6/11(木) 8:07 お礼
【61896】Re:消去作業について Hirofumi 09/6/11(木) 8:50 回答
【61897】Re:消去作業について Hirofumi 09/6/11(木) 10:42 発言
【61900】Re:消去作業について YOUSUKE 09/6/11(木) 14:13 お礼

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