Question

我有一个有行ID的表，我想根据价格标准删除具有相同行ID的每个行ID。

我可以删除行但是如果它是多次删除我将如何删除

如果price = 700，则删除整个范围内的行ID 3和4。我可以删除具有700但不确定如何删除具有相同ID的另一行的行。

for i = 1 to 10
   if cells(i,3).value = 700 then
        cells(i,3).EntireRow.Delete
        'how to delete the other row that has the same row id?
   End if
next i

Answer 1

在我的小测试中工作：

Sub DeleteRows()

    Dim rng As Range, rw As Range, k, dict, x As Long
    Dim rngDelete As Range

    Set dict = CreateObject("scripting.dictionary")

    Set rng = ActiveSheet.Range("A1").CurrentRegion

    'first pass - find all "duplicate" id's
    For x = 2 To rng.Rows.Count
        Set rw = rng.Rows(x)
        k = rw.Cells(1) & "~" & rw.Cells(2)
        If Application.CountIfs(rng.Columns(1), rw.Cells(1), _
                                rng.Columns(3), rw.Cells(3)) > 1 Then
            rw.Interior.Color = vbYellow '<<< for QC
            dict.Add k, True '<<remember this combination
        End If
    Next x
    'second pass - flag rows for deletion
    For x = 2 To rng.Rows.Count
        Set rw = rng.Rows(x)
        k = rw.Cells(1) & "~" & rw.Cells(2)
        If dict.exists(k) Then BuildRange rngDelete, rw
    Next x

    If Not rngDelete Is Nothing Then rngDelete.Delete

End Sub

Sub BuildRange(ByRef rngTot As Range, ByRef rngAdd As Range)
    If Not rngTot Is Nothing Then
        Set rngTot = Application.Union(rngTot, rngAdd)
    Else
        Set rngTot = rngAdd
    End If
End Sub

Answer 2

希望这样的事情能够适应您的需求：

Sub tgr()

    Const sIDCol As String = "B"
    Const sPriceCol As String = "C"

    Dim ws As Worksheet
    Dim rCheck As Range
    Dim rCheckCell As Range
    Dim rDel As Range

    Set ws = ActiveWorkbook.ActiveSheet
    Set rCheck = ws.Range(ws.Cells(1, sPriceCol), ws.Cells(ws.Rows.Count, sPriceCol).End(xlUp))

    For Each rCheckCell In rCheck.Cells                             'Loop through each cell in rCheck
        If rCheckCell.Value = 700 Then                              'If the cell = 700
            Select Case ws.Cells(rCheckCell.Row, sIDCol).Value
                Case 3, 4                                           'And the cell in column sIDCol in the same row = 3 or 4
                    If rDel Is Nothing Then                         'then add the cell to the rDel range
                        Set rDel = rCheckCell
                    Else
                        Set rDel = Union(rDel, rCheckCell)
                    End If

                Case Else
                    'Do nothing

            End Select
        End If
    Next rCheckCell

    If Not rDel Is Nothing Then rDel.EntireRow.Delete               'If there's anything in the rDel range, delete those rows

End Sub

如何删除具有条件的范围中的乘法行？

2 个答案: