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

我有一个表有行ID，我想要删除每个行ID与基于价格标准相同的行ID。

我能删除行，但如何删除，如果它是乘法

如果价格= 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

在我的小testing中工作：

 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