2

黄色の塗りつぶしのセルを含む範囲内のすべての行を削除しようとしてA7:AI300います（カラーインデックス6）色を含むすべての行を削除するコードがありますが、実行しようとしている問題がありますワークシート全体のコードであり、ワークブックがフリーズします。計算を高速化するために範囲を挿入しようとしています。範囲を挿入して機能させる方法を教えてもらえますか

Sub deleterow()
   Dim cell As Range
   For Each cell In Selection
       If cell.Interior.ColorIndex = 6 Then
           cell.EntireRow.Delete
       End If
   Next cell
End Sub
4

2 に答える 2

5

これはあなたがしようとしていることですか？ループ内の各行を削除するのではなく、最終的な「削除範囲」を作成していることに注意してください。これにより、コードの実行速度が向上します。

編集：範囲を見ている場合は"A7:A300"、このコードを使用してください

Sub deleterow()
   Dim cell As Range, DelRange As Range

   For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A7:A300")
       If cell.Interior.ColorIndex = 6 Then
           If DelRange Is Nothing Then
               Set DelRange = cell
           Else
               Set DelRange = Union(DelRange, cell)
           End If
       End If
   Next cell

   If Not DelRange Is Nothing Then DelRange.EntireRow.Delete
End Sub

そして、あなたが範囲を見ているなら"A7:AI300"、私はこれがあなたが望むものだと思います.

Sub deleterow()
   Dim cell As Range, DelRange As Range

   For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A7:AI300")
       If cell.Interior.ColorIndex = 6 Then
           If DelRange Is Nothing Then
               Set DelRange = cell
           Else
               Set DelRange = Union(DelRange, cell)
           End If
       End If
   Next cell

   If Not DelRange Is Nothing Then DelRange.Delete
End Sub

さらにフォローアップ

私はあなたが達成しようとしていることを最終的に理解したかもしれないと思います...

Sub deleterow()
    Dim i As Long, j As Long
    Dim delRange As Range

    With ThisWorkbook.Sheets("Sheet1")
        For i = 7 To 300 '<~~ Row 7 to 300
            For j = 1 To 35 <~~ Col A to AI
                If .Cells(i, j).Interior.ColorIndex = 6 Then
                    If delRange Is Nothing Then
                        Set delRange = .Cells(i, j)
                    Else
                        Set delRange = Union(delRange, .Cells(i, j))
                    End If
                    Exit For
                End If
            Next j
        Next i
    End With

    If Not delRange Is Nothing Then delRange.EntireRow.Delete
End Sub
于 2012-12-20T17:33:22.683 に答える
0

これがあなたができることです。計算を手動モードにします。代わりに、削除する必要がある範囲を設定しますselecting...

Sub deleterow()
     Dim myRange as Range
     Dim cell As Range

     Application.Calculation = xlCalculationManual
     Set myRange = Worksheets(1).Range("A1:A300") '-- just column A would do

     For Each cell In myRange
        If cell.Interior.ColorIndex = 6 Then
          cell.EntireRow.Delete
        End If
     Next cell

     Application.Calculation = xlCalculationAutomatic
 End Sub
于 2012-12-20T17:33:55.917 に答える