For ...各文は完全に完全なのですか？

Question

次のコードを実行すると、全体が完了しません。私は通常、その範囲内のすべてのデータが検査され、その条件が条件を満たす場合は行が削除されることを保証するために、それを数回実行する必要があります。

Const A% = 1 
Const B% = 2 
Const C% = 3 
Const D% = 4 

'Some code 

If myCL <> "" Then 
    For Each Cell In RngB.Cells 
     If Cell.Value <= myBal Then 
      r = Cell.Row 
      If ws.Cells(r, D) <= myScore And ws.Cells(r, C) Like myCL Then 
       Cell.EntireRow.Delete 
      End If 
     End If 
    Next Cell 
ElseIf myCL = "" Then 
    For Each Cell In RngB.Cells 
     If Cell.Value <= myBal Then 
      r = Cell.Row 
      If ws.Cells(r, D) <= myScore Then 
       Cell.EntireRow.Delete 
      End If 
     End If 
    Next Cell 
End If 

私はFor i = ## to 1 Step -1のようなものを使用しているとき、私は逆に範囲をループをする必要がありますが、私は、これは、このような状況に適用されることになるとは考えていないことを理解しています。

私の問題は、Cellが基準を満たす必要がある場合、そのコードをスキップしてコードを再実行すると、そのコードが削除されることです。

Answer 1

別の方法がある

から始まるのではなく、に行を追加します配列、または1つずつ行を削除して後でループすると、DelRngをとして定義しますオブジェクトです。

毎回、あなたがUnion機能を使用してDelRngオブジェクトへのを追加するよりも、あなたの基準を通過し、そして最後に、あなたはワンショットでDelRngを削除します。

コード

Dim DelRng As Range ' new range object, collects all rows that needs to be deleted 

If myCL <> "" Then 
    For Each Cell In RngB.Cells 
     If Cell.Value <= myBal Then 
      r = Cell.Row 
      If ws.Cells(r, D) <= myScore And ws.Cells(r, C) Like myCL Then 
       ' add current row to DelRng 
       If Not DelRng Is Nothing Then 
        Set DelRng = Application.Union(DelRng, .Rows(r)) 
       Else 
        Set DelRng = .Rows(r) 
       End If 
      End If 
     End If 
    Next cell 
ElseIf myCL = "" Then 
    For Each Cell In RngB.Cells 
     If Cell.Value <= myBal Then 
      r = Cell.Row 
      If ws.Cells(r, D) <= myScore Then 
       ' add current row to DelRng 
       If Not DelRng Is Nothing Then 
        Set DelRng = Application.Union(DelRng, .Rows(r)) 
       Else 
        Set DelRng = .Rows(r) 
       End If 
      End If 
     End If 
    Next cell 
End If 

' now delete the entire rows at once (will save you a lot of run-time) 
If Not DelRng Is Nothing Then DelRng.Delete 

Answer 2

For Eachステートメントの下にある敷物を引っ張っているのは、繰り返している行を削除することです（For Each上から下の行に向かって左から右へ走査します）。 Excelは、実際に行を削除した後の行にある「次の」セルで、通常は右に1つのセルで繰り返しを再開するのに十分です。しかし、あなたのコードは新しい現在の行の一番左のセルをすべて紛失しました。そのいくつかはあなたの基準を満たすかもしれません。

編集

問題がFor Eachループ内でそれらを削除せず、何とか削除する行のノートを取ることによって回避することができます。以下に示すようにやっての私の個人的な好みの方法は、Scripting.Dictionaryを使用することです：すべての行は、パフォーマンス向上のために、一度に削除され

Sub ForEachWithRowDeleteDemo() 
    Dim rangeOfInterest As Excel.Range 
    Dim cell As Excel.Range 
    Dim dicRowIndexesToDelete As Object 'Scripting.Dictionary 
    Dim rowIndex As Variant 

    Set rangeOfInterest = Sheet1.Range("A1:Z10") 'ASSUMPTION: rangeOfInterest is a contiguous range; no checks are made here. 
    Set dicRowIndexesToDelete = CreateObject("Scripting.Dictionary") 

    For Each cell In rangeOfInterest.Cells 
     If cell.Value2 = 123 Then '...your conditions go here. 
      'Cumulate distinct row indexes. 
      dicRowIndexesToDelete(cell.Row - rangeOfInterest.Row + 1) = True 
     End If 
    Next 

    If dicRowIndexesToDelete.Count > 0 Then 
     If rangeOfInterest.Cells.Count = 1 Then 
      'Exceptional case: rangeOfInterest is a single cell. 
      rangeOfInterest.EntireRow.Delete 
     Else 
      'Mark each of the range's rows. 
      rangeOfInterest.Clear 
      For Each rowIndex In dicRowIndexesToDelete.Keys 
       rangeOfInterest.Cells(rowIndex, 1) = True 
      Next 

      'Find the marks and delete the entire rows. 
      rangeOfInterest.SpecialCells(xlCellTypeConstants).EntireRow.Delete 
     End If 
    End If 

    Set dicRowIndexesToDelete = Nothing 
    Set cell = Nothing 
    Set rangeOfInterest = Nothing 
End Sub 

注意してください。これは、削除する行が8,192個を超えない別々の「島」である場合にのみ機能します。それを超えて、SpecialCellsメソッドは失敗します。 SpecialCellsは、1つのセルに適用された場合、ワークシート全体をその検索ゾーンと見なすため、例外的に単一のセル範囲を別々に処理する必要があります。

Answer 3

これは、直面している問題を回避するための概念の証明です。 For Loopsの行を削除する代わりに、を1次元のArrayに割り当ててから、文字列を作成してLoopの外に一度にすべての行を削除することができます。

最初の7行が記入されたシート上でこれを実行してから、再生して見てください。

Sub DeletingRows() 
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1) 
    Dim myArr(0 To 2) As Long 
    Dim myStr As String 

    myArr(0) = 2 
    myArr(1) = 4 
    myArr(2) = 6 

    For Each myRow In myArr 
     myStr = myStr & myRow & ":" & myRow & "," 
    Next myRow 

    myStr = Left(myStr, Len(myStr) - 1) 

    ws.Range(myStr).EntireRow.Delete 
End Sub 

---

あなたのコードにこれを統合する方法xがある

長い0

If myCL <> "" Then 
    For Each Cell In RngB.Cells 
     If Cell.Value <= myBal Then 
      r = Cell.Row 
      If ws.Cells(r, D) <= myScore And ws.Cells(r, C) Like myCL Then 
       myArr(x) = Cell.Row 
       x = x + 1 
      End If 
     End If 
    Next Cell 
ElseIf myCL = "" Then 
    For Each Cell In RngB.Cells 
     If Cell.Value <= myBal Then 
      r = Cell.Row 
      If ws.Cells(r, D) <= myScore Then 
       myArr(x) = Cell.Row 
       x = x + 1 
      End If 
     End If 
    Next Cell 
End If 
For Each myRow In myArr 
    myStr = myStr & myRow & ":" & myRow & "," 
Next myRow 

myStr = Left(myStr, Len(myStr) - 1) 

ws.Range(myStr).Delete