Excel中 - 删除行,如果不包含在列表中值的一个
我是新来的VBA,我想我最好解释一下我想要做的Excel中 - 删除行,如果不包含在列表中值的一个
我需要检查表1和表2 如果他们在行中有“AAA”或“BBB”或“CCC”的值,如果不是,则删除整行
我的下面的代码只能帮我删除行, AAA” Q列
我不知道如何添加更多的值,如“BBB”&“CCC”,如果该行有这些值,任一个,我想保留它
如何添加更多列来检查?现在只是在列Q中检查,如果我想从列H检查它到R?
我实际上有10个值(AAA,BBB,CCC .... JJJ)想要保留,是否需要逐个输入,或者有一种方法要求excel 检查列表中,如果在表1,并与任何 一个从这些10个值匹配的表2中的任何细胞,保留该行,否则,删除整个 行
列表是在表3从塔A1定位:A10
谢谢! 我的代码如下
Sub RemoveCell()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With Sheets("Sheet1")
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
'loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "Q")
If Not IsError(.Value) Then
If .Value <> "AAA" Then .EntireRow.Delete
End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
在这里,你只好使用这样:
Sub Test_CheL()
'''Tune the parameters to fit your need : Sheet1 and AAA/BBB/CCC/JJJ
Call DeleteRowsNotContaining(ThisWorkbook.Sheets("Sheet1"), "AAA/BBB/CCC/JJJ")
End Sub
我增加了一些事情,以改善性能和稳定性:
-
EnableEvents = False
, 删除行后个
- 重新显示PageBreaks,
- 几
Exit For
,以免发生维持循环,当你有足够的去 - 店单元格的值到一个变量来提高性能的同时对阵列的值测试
代码以除去在列表不含任何值的行:
Sub DeleteRowsNotContaining(wS As Worksheet, ValuesToKeep As String)
Dim FirstRow As Long
Dim LastRow As Long
Dim LastColInRow As Long
Dim LoopRow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim VtK() As String
Dim i As Integer
Dim KeepRow As Boolean
Dim CelRg As Range
Dim CelStr As String
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
VtK = Split(ValuesToKeep, "/")
With wS
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
'''Set the first and last row to loop through
FirstRow = .UsedRange.Cells(1, 1).Row
LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
'''Loop from Lastrow to Firstrow (bottom to top)
For LoopRow = LastRow To FirstRow Step -1
'''If you don't find any of your values, delete the row
KeepRow = False
LastColInRow = .Cells(LoopRow, .Columns.Count).End(xlToLeft).Column
With .Range(.Cells(LoopRow, "A"), .Cells(LoopRow, LastColInRow))
For Each CelRg In .Cells
'''If cell contains an error, go directly to the next cell
If IsError(CelRg.Value) Then
Else
CelStr = CStr(CelRg.Value)
For i = LBound(VtK) To UBound(VtK)
If CelStr <> VtK(i) Then
Else
'''Cell contains a value to keep
KeepRow = True
Exit For
End If
Next i
'''If you already found a value you want to keep, go next line
If KeepRow Then Exit For
End If
Next CelRg
'''Check if you need to delete the row
If Not KeepRow Then .EntireRow.Delete
End With '.Range(.Cells(LoopRow, "A"), .Cells(LoopRow, LastColInRow))
Next LoopRow
.DisplayPageBreaks = True
End With 'wS
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
你可以尝试使用数组来检查,如果你正在寻找的价值存在。 子“FillArray”用表3中的数据填充数组。如果添加更多值,则可以更改范围,或者更改代码以动态检查数组的大小应该是多少。 代码:
Dim arr(9) As Variant
Sub RemoveCell()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim colsTocheck As Integer
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Call FillArray
With Sheets("Sheet1")
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
'loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1
deleteRow = False
For colsTocheck = 8 To 18 '8 is H 18 is R - i find it easier to use column numbers
With .Cells(Lrow, colsTocheck)
If IsError(.Value) = False And .Value <> "" Then
If IsInArray(.Value, arr) Then
deleteRow = False
Exit For
Else
deleteRow = True
End If
End If
End With
Next colsTocheck
If deleteRow Then .Cells(Lrow, colsTocheck).EntireRow.Delete
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean 'chceck if value is in array
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Sub FillArray() 'fill array with values to check against
Dim sList As Worksheet
Set sList = Sheets("Sheet3")
For i = 0 To 9
arr(i) = sList.Cells(i + 1, 1)
Next i
End Sub
您应该在测试错误后放置'lol = .Value',然后使用它:'If Not IsInArray(lol,arr)Then .EntireRow.Delete' – R3uK
嗨Cudny,感谢您的代码,上面,结果是所有行删除...是不是有什么问题?请你帮忙,谢谢! –
嗨R3uK,我发现行“lol = .Value”,我应该删除它?我应该在哪里放置“If IsInArray(lol,arr)Then .EntireRow.Delete” –
只求当你循环遍历行时,你也应该遍历列。首先定义具有数据的最后一列,然后逐步完成。要添加BBB和CCC,您应该查看IF语句中的OR运算符。 – Luuklag
欢迎来到SO,请参加[旅游](点击它)了解这个社区如何运作! ;) – R3uK