Excel VBA質問箱 IV

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

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


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

【46935】[行]の一括削除方法 ボビー 07/2/22(木) 14:13 質問[未読]
【46936】Re:[行]の一括削除方法 りん 07/2/22(木) 15:56 回答[未読]
【46939】Re:[行]の一括削除方法 ボビー 07/2/22(木) 16:28 お礼[未読]

【46935】[行]の一括削除方法
質問  ボビー  - 07/2/22(木) 14:13 -

引用なし
パスワード
   以下のような[#]の付与された行の削除を一括して行うロジックを組みましたが、数件の場合は[OK]なのですが、大量(今回は100件以上)に処理をした場合、削除実行(Selection.Delete Shift:=xlUp)にてエラー[1004]が返され処理化中断してしまいます。
少量を数回に分けて実行すると都度対象行番号を検索しなくてはならず、処理負荷が大きいのです。
下記とは別の方法がありましたら、アドバイス願います。
宜しくお願い致します。


Private Sub CommandButton2_Click()
  Dim strDelRowNo(200)  As String
  Dim strDelRow      As String
  Dim intLastRow     As Integer
  Dim intI01       As Integer
  Dim intJ01       As Integer
  Dim intK01       As Integer
  Dim intL01       As Integer

  Application.ExecuteExcel4Macro "echo(False)"

  intLastRow = Range("$B$65536").End(xlUp).Row

  intJ01 = 0
  For intI01 = 4 To intLastRow
    If Cells(intI01, 1) = "#" Then
      intJ01 = intJ01 + 1
      strDelRowNo(intJ01) = intI01
    End If
  Next

  If strDelRowNo(1) = "" Then
    GoTo EndStep
  End If

  strDelRow = strDelRowNo(1) & ":" & strDelRowNo(1)
  For intK01 = 2 To 200
    If strDelRowNo(intK01) <> "" Then
      strDelRow = strDelRow & "," & strDelRowNo(intK01) _
           & ":" & strDelRowNo(intK01)
    Else
      Exit For
    End If
  Next

  '************
  '** 削除 **
  '************
  Range(strDelRow).Select
  Selection.Delete Shift:=xlUp
  If Err Then
    MsgBox "エラー番号 = " & Err.Number
  End If

  〜〜〜〜〜 以降は省略 〜〜〜〜〜

【46936】Re:[行]の一括削除方法
回答  りん E-MAIL  - 07/2/22(木) 15:56 -

引用なし
パスワード
   ボビー さん、こんにちわ。
>以下のような[#]の付与された行の削除を一括して行うロジックを組みましたが、数件の場合は[OK]なのですが、大量(今回は100件以上)に処理をした場合、削除実行(Selection.Delete Shift:=xlUp)にてエラー[1004]が返され処理化中断してしまいます。
範囲を指定するための文字列が長すぎるのかもしれませんね。

文字列にせずにセルを直接変数に追加セットし、行全体を削除します。
データは65536行入っていないものとします。
続きがわからないので、変数の宣言を省いてあります。

Private Sub CommandButton2_Click()
  Dim r1 as Range
  Application.ScreenUpdating = False '画面更新なし
  '
  intLastRow = Range("$B$65536").End(xlUp).Row
  '65536行使っていないとして
  Set r1 = Cells(intLastRow + 1, 2) '削除しても問題ない行をセット
  '
  For intI01 = 4 To intLastRow
   If Cells(intI01, 1).Value = "#" Then
     Set r1 = Application.Union(r1, Cells(intI01, 1)) '追加セット
   End If
  Next
  '
  '************
  '** 削除 **
  '************
  r1.EntireRow.Delete
  Set r1 = Nothing
  '
  Application.ScreenUpdating = True
End Sub

計算方法が手動で、改ページを表示していないと処理が速くなります。

【46939】Re:[行]の一括削除方法
お礼  ボビー  - 07/2/22(木) 16:28 -

引用なし
パスワード
   ▼りん さん:
提示いただいたロジックと、過去ログの[列削除]を参考に処理を満足いたしました。
本当にありがとうございました。

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