从每个循环的select中删除特定的行

我试图删除不包含新单词的行。

我做的事：

1. 手动select多行
2. 运行macros，它检查每一行，并将新的单词添加到字典中。 如果没有新词 – 行应该被删除。

问题是：当macros删除一行时，应该用“Next cell”去下一行，但是跳过一行。

我需要你的帮助，因为我不知道如何使它在VBA工作（新手在这里）。 如何防止在select中跳过和处理每一行？

演示数据：

ABABC CBAC ABF 

我的结果：

 ABABC AC ABF 

应该：

 ABABC ABF 

码：

 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