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

debugcn 发表于 Dev

安德烈

我正在尝试删除不包含新单词的行。

我做的事情：

手动选择多行
运行宏，它检查每一行并将其中的新单词添加到字典中。如果没有新词 - 应删除该行。

问题：当宏删除一行时，它应该使用“下一个单元格”转到下一行，但它会跳过一个。

我需要你的帮助，因为我不知道如何让它在 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

用户4039065

删除行时始终从底部到顶部运行，否则可能会跳过行（如您所见）。

'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

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。