各ループの選択から特定の行を削除します。

Question

新しい単語を含まない行を削除しようとしています。私は何

：

1. 複数の行にそれぞれの行をチェックし、 が辞書にそれから新しい単語を追加し、手動で
2. 実行マクロを選択します。新しい単語がない場合 - 行を削除する必要があります。

問題： マクロが行を削除すると、それは「次のセル」の次の行に行く必要があり、それが1つをスキップします。

私はVBA（ここでは初心者）で動作させる方法がないので、あなたの助けが必要です。 どのようにスキップし、選択の各行を処理しないようにするには？

デモデータ：

A B 
A B C 
C B 
A C 
A B F 

マイ結果：

A B 
A B C 
A C 
A B F 

は次のようになります。

A B 
A B C 
A B F 

コード：

Sub clean_keys() 

' unique words 
Dim dict As Object 
Set dict = CreateObject("Scripting.Dictionary") 

For Each cell In Selection 

    Dim strArray() As String 
    Dim intCount As Integer 

    strArray = Split(cell.Value, " ") 

    Dim intWords As Integer 
    intWords = 0 

    For intCount = LBound(strArray) To UBound(strArray) 

     If dict.Exists(Trim(strArray(intCount))) Then 
      dict(Trim(strArray(intCount))) = dict(Trim(strArray(intCount))) + 1 
     Else 
      dict.Add Key:=Trim(strArray(intCount)), Item:=1 
      intWords = intWords + 1 
     End If 

    Next 

    If intWords = 0 Then 
     cell.EntireRow.Delete 
    End If 

Next cell 
End Sub 

Answer 1

行を削除する場合や行をスキップする場合（気づいたように）、常に下から上に実行してください。

'don't dim inside a loop 
Dim r As Long 
Dim strArray As Variant 
Dim intCount As Integer 
Dim intWords As Integer 

With Selection 
    For r = .Rows.Count To 1 Step -1 

     strArray = Split(Selection.Cells(r).Value & " ", " ") 
     intWords = 0 

     For intCount = LBound(strArray) To UBound(strArray) - 1 
      If dict.Exists(Trim(strArray(intCount))) Then 
       dict(Trim(strArray(intCount))) = dict(Trim(strArray(intCount))) + 1 
      Else 
       dict.Add Key:=Trim(strArray(intCount)), Item:=1 
       intWords = intWords + 1 
      End If 
     Next intCount 

     If intWords = 0 Then 
      .Cells(r).EntireRow.Delete 
     End If 

    Next r 
End With