从每个循环的选择中删除特定行 [英] Delete specific rows from selection in for each loop

问题描述

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

I'm trying to delete rows which don't contain new words.

我做什么:

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

1. Select multiple rows manually
2. Run macro, which checks each row and adds new words from it to a dictionary. If there are no new words - the row should be deleted.

问题: 当宏删除一行时，它应转到带有下一个单元格"的下一行，但会跳过一个.

The problem: When macro deletes a row, it should go to the next row with "Next cell", but it skips one.

我需要您的帮助，因为我不知道如何在VBA中工作(这里是新手). 如何防止跳过并处理选择的每一行?

I need your help because I have no Idea how to make it work in VBA (newbie here). How to prevent that skipping and process each row in selection?

演示数据:

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

推荐答案

删除行时始终从下到上运行，否则您可能会跳过行(如您所注意到的那样).

Always run from the bottom to the top when deleting rows or you risk skipping rows (as you have noticed).

'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

这篇关于从每个循环的选择中删除特定行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！