vba 根据单元格值删除整行
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/23523945/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Delete Entire Rows Based on Cell Values
提问by user3613124
I want in Excel (2003) to take an imported data dump and format it into a report. Most of what I have done has involved recording a macro and then customizing the code where needed. I have a spot that requires pure code.
我想在 Excel (2003) 中获取导入的数据转储并将其格式化为报告。我所做的大部分工作都涉及录制宏,然后在需要的地方自定义代码。我有一个需要纯代码的地方。
I have a SORTED column (D) that lists types of incidences (for example: vehicle fires, strokes, animal bites, etc). I would like to read each value in column D and if it is NOT one of several values we are looking for, delete the entire row.
我有一个 SORTED 列 (D),其中列出了事故类型(例如:车辆起火、中风、动物咬伤等)。我想读取 D 列中的每个值,如果它不是我们要查找的几个值之一,请删除整行。
I have tried multiple versions of code (that I have found online) and the code that produces the results closest to what I need looks like this:
我尝试了多个版本的代码(我在网上找到的),产生最接近我需要的结果的代码如下所示:
Range("D:D").Select
Dim workrange As Range
Dim cell As Range
Set workrange = Intersect(Selection, ActiveSheet.UsedRange)
For Each cell In workrange
If ActiveCell.Value <> "VFIRE" _
And ActiveCell.Value <> "ILBURN" _
And ActiveCell.Value <> "SMOKEA" _
And ActiveCell.Value <> "ST3" _
And ActiveCell.Value <> "TA1PED" _
And ActiveCell.Value <> "UN1" _
Then ActiveCell.EntireRow.Delete
Next cell
End Sub
This code deletes a majority of the list (~100 rows of the original 168), but it is only deleting the rows until it hits the first value of something I want. For example, this current data dump does not have any values for "ILBURN" or "SMOKEA", but when the first occurrence of "ST3" occurs the macro stops. There is no error generated, it just seems to think it is done.
这段代码删除了大部分列表(原始 168 行的约 100 行),但它只会删除行,直到它达到我想要的第一个值。例如,当前的数据转储没有“ILBURN”或“SMOKEA”的任何值,但是当第一次出现“ST3”时宏停止。没有产生错误,它只是似乎认为它已经完成了。
What should I add to invoke the macro through the entire list?
我应该添加什么来通过整个列表调用宏?
采纳答案by tbur
I'm all about brevity.
我都是关于简洁的。
Sub DeleteRowBasedOnCriteria()
Dim RowToTest As Long
For RowToTest = Cells(Rows.Count, 4).End(xlUp).Row To 2 Step -1
With Cells(RowToTest, 4)
If .Value <> "VFIRE" _
And .Value <> "ILBURN" _
And .Value <> "SMOKEA" _
And .Value <> "ST3" _
And .Value <> "TA1PED" _
And .Value <> "UN1" _
Then _
Rows(RowToTest).EntireRow.Delete
End With
Next RowToTest
End Sub
回答by mdkarthikeyan
I used this in one of my task, where as I had array of test data of 100 iteration, which I want to trim to first 10 iteration, so I used the "iteration# > 10" cells to delete entire row.
我在我的一项任务中使用了它,因为我有 100 次迭代的测试数据数组,我想将其修剪为前 10 次迭代,因此我使用“迭代#> 10”单元格来删除整行。
Sub trim_row()
' trim_row Macro
' to trim row which is greater than iteration#10
Dim RowToTest As Long
Dim temp As String
Dim temp1 As Integer
For RowToTest = Cells(Rows.Count, 6).End(xlUp).Row To 2 Step -1
With Cells(RowToTest, 6)
temp = .Value
If temp = "" Then
Else
temp1 = Trim(Replace(temp, "Iteration# :: ", ""))
If temp1 > 10 Then
Rows(RowToTest).EntireRow.Delete
End If
End If
End With
Next RowToTest
End Sub
I user replace & trip to extract number from the string, and introduced the if = "" condition to skip the empty rows. I had empty row separating to set of test data.
我用户 replace & trip 从字符串中提取数字,并引入 if = "" 条件来跳过空行。我将空行分隔到一组测试数据。
回答by Adach1979
I agree with @Tim_Williams that you need to work backwards as that seems to be the issue. I would do something like this.
我同意@Tim_Williams 的观点,您需要向后工作,因为这似乎是问题所在。我会做这样的事情。
Sub Main()
Dim workrange As Range
Dim Firstrow As Integer
Dim Lastrow As Integer
Dim lrow As Integer
'Find first and last used row in column D
Range("D:D").Select
Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.Range("D1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row
'Loop through used cells backwards and delete if needed
For lrow = Lastrow To Firstrow Step -1
Set workrange = Cells(lrow, 4)
If workrange.Value <> "VFIRE" _
And workrange.Value <> "ILBURN" _
And workrange.Value <> "SMOKEA" _
And workrange.Value <> "ST3" _
And workrange.Value <> "TA1PED" _
And workrange.Value <> "UN1" _
Then workrange.EntireRow.Delete
Next lrow
End Sub