我想创建一个宏,以删除Excel文档中包含某些值(例如“红色”,“蓝色”和“黄色”)的所有行。
我找到了一些适用于单个值的代码。我试图进行一些更改,但无法使它适用于多个值。
Sub Colors()
Dim pattern As String
pattern = "red"
RowCount = ActiveSheet.UsedRange.Rows.Count
Dim i As Integer
For i = 1 To RowCount
Dim j As Integer
For j = 1 To 1
If Cells(i, j) = pattern Then
Cells(i, j).EntireRow.Delete
End If
Next j
Next i
End Sub
您如何列出更多模式?
答案 0 :(得分:3)
类似的事情应该起作用。您可以使用集合来保存所有模式并进行遍历。另外,您也可以在If语句上使用一系列or语句。
进行一些调整以改善此问题。您可能还想在不与单元格进行交互的位置显式声明一个工作表。此外,由于不需要,我删除了For j
循环。
Option Explicit
Sub Colors()
Dim i As Long
Dim j As Long
Dim RowCount As Long
Dim patterns As Collection: Set patterns = New Collection
Dim pattern As Variant
patterns.Add "red"
patterns.Add "blue"
patterns.Add "yellow"
RowCount = ActiveSheet.UsedRange.Rows.Count
For i = RowCount To 1 Step -1
For Each pattern In patterns
If Cells(i, 1) = pattern Then
Cells(i, 1).EntireRow.Delete
exit for
end if
Next
Next
End Sub
答案 1 :(得分:0)
Sub Colors()
Dim pattern As String
Dim i As Long, j As Long
RowCount = ActiveSheet.UsedRange.Rows.Count
For i = RowCount To 1 Step -1
If Cells(i, 1) = "red" Or Cells(i, 1) = "blue" Or Cells(i, 1) = "yellow" Then
Cells(i, 1).EntireRow.Delete
End If
Next i
End Sub
您可以使用or
运算符来指定多个条件。这样会搜索第1列,您可以更改单元格索引以调整行。
答案 2 :(得分:0)
尝试:
Option Explicit
Sub Colors()
Dim arr As Variant
Dim LastRow As Long, i As Long, j As Long
Dim Color As String
arr = Array("Red", "Blue", "Yellow")
'It is better to create a with statement with th workbook you want to work
With ThisWorkbook.Worksheets("Sheet1")
'It is better to avoid the usedrange, instead use a specific when you calculating the lastrow
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Loop if you delete you loop from bottom to top
For i = LastRow To 1 Step -1
'Get the color in cell i column A
Color = .Cells(i, 1).Value
'Loop array with colors
For j = LBound(arr) To UBound(arr)
'If color much
If Color = arr(j) Then
'Delete row
.Rows(i).EntireRow.Delete
Exit For
End If
Next j
Next i
End With
End Sub
答案 3 :(得分:0)
不要循环。在更大的数据集上,这将花费很长时间。
出于相同的原因,请不要删除。
相反:过滤,将数据集复制到新工作表,然后删除旧工作表。
Sub Macro1()
'
' Macro1 Macro
'
Dim mySheetname As String
Dim mySheetnameOld As String
Dim lastRow As Long
'Replace "Sheet1" with your sheet name.
mySheetname = "Sheet1"
mySheetnameOld = mySheetname & "_Old"
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Sheets(mySheetname).Name = mySheetname & "_Old"
' Add/remove your cell criteria to/from the filter array
Sheets(mySheetnameOld).Rows("1:" & lastRow).AutoFilter Field:=1, Criteria1:=Array( _
"Blue", "Green", "Red", "Yellow"), Operator:=xlFilterValues
Sheets.Add After:=Sheets(mySheetnameOld)
ActiveSheet.Name = mySheetname
Sheets(mySheetnameOld).Select
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Rows("1:" & lastRow).Copy Sheets(mySheetname).Cells(1, 1)
Application.DisplayAlerts = False
Sheets("Sheet1_Old").Delete
Application.DisplayAlerts = True
End Sub