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

时间:2017-06-10 17:05:17

标签: excel vba excel-vba

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

我做了什么:

  1. 手动选择多行
  2. 运行宏,检查每一行和 将新单词添加到字典中。如果没有新词 - 该行应删除。
  3. 问题: 当宏删除一行时,它应该使用"下一个单元格"进入下一行,但它会跳过一行。

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

1 个答案:

答案 0 :(得分:2)

删除行时始终从底部运行到顶部,否则您可能会跳过行(正如您所注意到的那样)。

'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