教えて!gooにおける不適切な投稿への対応について

以前、質問で複数の行をRangeに格納し一括で削除する方法を教えていただきました。
実践したコードが以下の通りです。
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Unionで指定の行を複数格納
For i = TergetSetSheets.Range("Y" & Rows.Count).End(xlUp).Row To 7 Step -7
If SetRan Is Nothing Then
Set SetRan = TergetSetSheets.Rows(i - p)
Else
Set SetRan = Union(SetRan, TergetSetSheets.Rows(i - p))
End If
Next
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
500行くらいなら0.03秒くらいで処理できていたのですが、
4700行で6.8秒、9400行で52秒になりました。
※描写は停止にしています。
これ以上早く処理を行うことはできるのでしょうか?
なるべくなら行の削除を行いたいと思っています。
なぜなら表の集計をこの後に行うのにあらかじめ不要な行を先に削除しておくことにより
処理速度が上がるのではないかと思っているからです。

いい方法がありましたら知恵を貸してください。
どうかよろしくお願いいたします。

gooドクター

A 回答 (2件)

まず現行マクロの改良としては、「オブジェクトに触る回数を少なくする」


TergetSetSheetsこれはワークシートだと思いますが、ループ内で9000行処理するなら9000回同じシート名を指定することになり、低速化の原因になります。下記のようにすると指定が省略されて速く、しかも見た目スッキリで可読性が上がります。
With TergetSetSheets
For i = .Range("Y" & Rows.Count).End(xlUp).Row To 7 Step -7
If SetRan Is Nothing Then
Set SetRan = .Rows(i - p)
Else
Set SetRan = Union(SetRan, .Rows(i - p))
End If
Next
End With

SetRanはセルではなく行のようですね。遅くなりませんか?1セルだけであっても、一括削除する際にEntireRowとすれば行になりますよ。この比較は私もしたことがないので、確信持っては言えませんが。

次に、削除せず残す方に規則性があるなら、Autofilterを使う方法があります。マクロでなく通常の手動操作でもフィルタがありますが、あれです。あれで削除する行「以外」が表示されるようにして、全選択→コピー→別シートにペースト これでも速いです。これを考えると、手動でもいいんじゃないの?とか藪蛇な思いがあります(笑)

Union の後で一括deleteもAutofilterもそうですが、エクセルでは一気に選択、一気に処理するのが速いです。乱暴に言うと一行ステートメントで「一括処理」するのが速いのです。その意味ではFor Nextループは一回ずつ順番に9000回処理するため、低速化の一因になります。しかし今回の場合、やらない訳には行きませんので残してます。

老婆心ながら、エクセルVBAの質問なら、カテゴリはVisual Basicまたはエクセルが良いです。
    • good
    • 1
この回答へのお礼

回答者1の30246kikuさんの対策とHigh_Scoreさんの対策を試してみました。
----------------------------------------------------------------
データ数     588     9408    65534  
従来      0.046875  50.20313  終わらない
対処1     0.0390625  51.44531  終わらない
対処2     0.05078125 52.30859  終わらない
AutoFilter    0.4765625 0.7578125 8.277344
30246kikuさん 0.2070313 0.90625 35.40234
----------------------------------------------------------------
※対処1:オブジェクトに触れる回数を減らす
※対処2:Rowではなくセル指定

以上のような結果になりました。
今回は実装が簡単で処理が速いオートフィルターを使用してみたいと思います。
コピー後の貼り付けでフィルターで除外されたものはコピーされないとは知りませんでした;(非表示だからそのままコピーされるのかと思っていました;)

あと今後もVBAで質問があるときはカテゴリに気を付けたいと思います。
とても勉強になりました。
ありがとうございます。

お礼日時:2015/04/22 14:57

> 例:


>   A  B
> 1 太郎 住所
> 2    電話
> 3    メールアドレス
> 4    誕生日
> 5    年齢
> 6    性別
> 7    既婚
> 8 花子 住所
> 以下続く

この7行が繰り返されていて、
例えば、年齢、既婚 部分の行を一気に消したい・・・
という事で良かったでしょうか

作業列として、今使っている最終列+2の所の列を使います。
その作業列に
=IF(INDEX({0,0,0,0,1,0,1},MOD(ROW()-1,7)+1)>0,1,"")
という計算式を埋め込んで、削除する行を特定します。
{0,0,0,0,1,0,1} このパターンは、
左から、住所、電話・・・に対応していて、削除したい所を > 0 で設定します。
{0,0,0,0,1,0,1}
↓誕生日も削除対象にするのなら、左から4つ目の 0 を変更
{0,0,0,1,1,0,1}

以下の Samp1 でどうなりますか?


Option Explicit

Public Sub Samp1()
  Dim iRowH As Long, iCol As Long
  Dim i As Long
  Const CLIMIT As Long = 5000

  With ActiveSheet
    With .UsedRange
      With .Cells(.Rows.Count, .Columns.Count)
        iCol = .Column + 2
        iRowH = .Row
      End With
    End With
    With .Cells(1, iCol).Resize(iRowH)
      .Formula = _
        "=IF(INDEX({0,0,0,0,1,0,1},MOD(ROW()-1,7)+1)>0,1,"""")"
      .Value = .Value
      On Error Resume Next
      For i = (iRowH - 1) \ CLIMIT To 0 Step -1
        .Cells(i * CLIMIT + 1).Resize(CLIMIT) _
          .SpecialCells(xlCellTypeConstants, xlNumbers) _
          .EntireRow.Delete
      Next
      .ClearContents
    End With
  End With
End Sub


※ 速くならなかったらごめんなさい

※ ScreenUpdating 等は必要に応じて追加してください


なお、確認用データは以下で作ってました

Public Sub testData()
  Dim r As Range

  For Each r In Range("A1:Z30000")
    r = r.Address(False, False)
  Next
  Columns.AutoFit
End Sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
歴然と速くなりました!!
またとても勉強になりました。
今後VBAでプログラムを行うときは参考にさせていただきます。
ありがとうございました。

お礼日時:2015/04/22 15:02

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

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング