excel - Excel 2016 VBA删除具有某些条件的行

这并不像最初看起来那么容易。每次我们循环行并根据某些标准删除行时都会遇到问题。我们删除了我们所在的行，然后移动到下一行，但是因为我们删除了我们所在的行，所以我们已经在下一行了。这就像我们走路时把地毯从我们下面拉出来一样。

为了解决这些问题，我们通常会在一个范围内后退并删除，但是......因为在这种情况下，我们只是根据我们已经找到的内容进行删除，所以我们必须前进。

有几种方法可以解决这个问题。我认为最安全和最稳健的方法是循环一次以获取每个术语的计数，然后再次循环并根据我们在第一个循环中找到的内容删除适当数量的行。通过这种方式，我们可以控制删除的内容以及每次迭代的步长。它还降低了我们在跟踪所发现的内容、其中的多少、是否需要删除当前行以及如果我们这样做时如何处理循环时所面临的复杂性。

Sub removeRows()
    Dim rngRow As Range
    Dim dictTerms As Scripting.Dictionary

    'Initialize Dictionary
    Set dictTerms = New Scripting.Dictionary

    'Load up dictionary using the term as the key and the count as the value
    ' by looping through each row that holds the terms
    For Each rngRow In Sheet1.Rows("3:17")
        'Only upsert to dictionary if we have a valule
        If rngRow.Cells(1, 1).Value <> "" Then
            If dictTerms.Exists(rngRow.Cells(1, 1).Value) Then
                'increment value
                dictTerms(rngRow.Cells(1, 1).Value) = dictTerms(rngRow.Cells(1, 1).Value) + 1
            Else
                'Add to dictionary with value 1
                dictTerms.Add Key:=rngRow.Cells(1, 1).Value, Item:=1
            End If
        End If
    Next rngRow

    Dim intRow As Integer: intRow = 3
    Dim intCounter As Integer
    Dim termCount As Integer

    'Loop through rows starting at intRow(set to 3 above) and ending at 17 (possible max)
    Do While intCounter <= 17

        'Skip blank rows
        If Sheet1.Cells(intRow, 1).Value <> "" Then

            'grab the number of terms encounterd so we know how much to delete
            termCount = dictTerms(Sheet1.Cells(intRow, 1).Value)

            'If it's more than two, then delete the remaining
            If termCount > 2 Then Sheet1.Rows(intRow + 2 & ":" & intRow + termCount - 1).Delete

            'Increment past what we deleted (or found if we didn't delete anything)
            intRow = intRow + 2 + (termCount <> 1)

            'Set the loop counter.
            intCounter = intCounter + termCount

        Else
            'We found a blank, just increment our loop counter
            intCounter = intCounter + 1
            intRow = intRow + 1
        End If
    Loop

End Sub

您需要转到 Tools>>References 并添加 Microsoft Scripting Runtime（在大列表中选中它旁边的复选框并点击 OK），以便我们可以使用 Scripting.Dictionary。

您还需要编辑对 Sheet1 的引用到您所在的任何工作表。并且可能提到将Cells(1,1)第一个 1 更改为我们正在分析的任何列（此处假定为“A”列）。最后，您需要调整这些值startRow并将其endRow设置为适合您工作簿的任何值。

excel - Excel 2016 VBA删除具有某些条件的行

问题描述

解决方案

推荐阅读