根据匹配条件删除行

时间:2012-05-29 15:14:30

标签: excel vba excel-vba

我有一个过时的CS学位,所以我理解VB的基础知识,但我不经常写宏,需要帮助解决一个特定的条件。 (...但我理解函数和面向对象的编程)

假设如下:   - 列A包含字母数字形式的参考ID,按字母顺序排序。   - B列包含文本字符串或空格。

我正在尝试编写一个宏,根据B列中“Notes”的内容自动删除每个唯一引用号的任何额外行。问题是如果列A有多个唯一引用号的实例,我需要确定哪一行包含B列中的内容。有一个问题:参考号可能在B列中没有任何内容,应该保留。

进一步解释,在下面的截图中我需要:

  • 保持黄色突出显示的行
  • 删除剩余的行

我尝试使用右侧的括号显示报告如何显示数据的各种配置,并标记为红色。很难解释我正在尝试做什么,所以我想图片会更清楚地显示我需要的东西。

此任务使报告非常手动且耗时。

1 个答案:

答案 0 :(得分:0)

这很简单 你只需要通过行检查这行是否需要删除,需要删除具有此ID的前一行或者不应该发生任何事情。 在我的例子中,我标记这些行并最后删除它们。

Sub foo()
Dim rngSelection As Range
Dim startingRow As Integer
Dim endRow As Integer
Dim idColumn As Integer
Dim noteColumn As Integer
Dim idValuableRow As New Dictionary
Dim deleteRows As New Collection

Set rngSelection = Selection
startingRow = rngSelection.Row
endRow = rngSelection.Rows.Count + startingRow - 1


idColumn = rngSelection.Column
noteColumn = idColumn + 1

For i = startingRow To endRow
    currentID = Cells(i, idColumn)
    If idValuableRow.Exists(currentID) Then
        If Trim(idValuableRow(currentID)("note")) <> "" And Trim(Cells(i, noteColumn)) = "" Then
            deleteRows.Add i
         ElseIf idValuableRow(currentID)("note") = "" And Trim(Cells(i, noteColumn)) <> "" Then
            deleteRows.Add idValuableRow(currentID)("row")
            idValuableRow(currentID)("row") = i
            idValuableRow(currentID)("note") = Cells(i, noteColumn)
        End If
    Else
        Dim arr(2) As Variant
        idValuableRow.Add currentID, New Dictionary
        idValuableRow(currentID).Add "row", i
        idValuableRow(currentID).Add "note", Cells(i, noteColumn)
    End If


Next i
deletedRows = 0
For Each element In deleteRows
    If element <> "" Then
        Rows(element - deletedRows & ":" & element - deletedRows).Select
        Selection.Delete Shift:=xlUp
        deletedRows = deletedRows + 1

        End If
    Next element

End Sub

它可能看起来像这样。您唯一需要的是在工具/参考中添加Microsoft Scripting Runtime