Question

我有以下数据。 Sample Data

如果同一任务出现多于2行，则需要删除第3、4，...重复行。这些行已经按任务名称和修改日期排序。我只需要最新的数据和1个先前的数据（同一任务的前2行）。

在上图中，应删除第7、8、9、13、14、15、16、17行...

Answer 1

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

要解决这些问题，我们通常会向后退一步并删除，但是...因为在这种情况下，我们仅基于已经找到的内容进行删除，所以我们必须前进。

有几种方法可以解决这个问题。我认为最安全，最可靠的方法是循环一次以获取每个术语的计数，然后再次循环并根据我们在第一个循环中发现的内容删除相应数量的行。这样，我们可以控制要删除的内容以及每次迭代的步幅。它还降低了在跟踪找到的内容，要删除多少内容（如果需要删除当前行）以及如何处理循环时遇到的复杂性。

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

您需要转到工具>>参考，并添加Microsoft Scripting Runtime（在大列表中选中它旁边的复选框，然后单击OK），以便我们可以使用Scripting.Dictionary。

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

Answer 2

@JNevill，当您提到每个任务的计数器时，我只是想到了一些简单的方法，现在我只需要弄清楚如何在新列中删除值大于2的行...而无需获取错误脚本超出范围或删除范围类的方法失败

'Declare Variables
    Dim tableName As String
    Dim activeSheetName As String
    Dim totalrows As Long


'Identify Active Sheet Name
    activeSheetName = ActiveSheet.Name

'Identify Active Table Name
    tableName = ActiveSheet.ListObjects(1).Name

'Identify total number of rows
    totalrows = Worksheets(activeSheetName).Range(tableName).Rows.count '99

'Insert counter column
Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Dim taskCounter As Long
Dim rowNum As Integer
rowNum = 2
taskCounter = 0

For a = 1 To totalrows + 1

    If Range("A" & rowNum) = "" Then
        taskCounter = 0
        Range("B" & rowNum).Value = taskCounter
    Else
        taskCounter = taskCounter + 1
        Range("B" & rowNum).Value = taskCounter
    End If

    rowNum = rowNum + 1
Next a

Excel 2016 VBA删除具有特定条件的行

2 个答案: