根据数组中没有单元格值删除/过滤行-VBA[重复]
根据数组中没有单元格值删除/过滤行-VBA[重复]
提问于 2018-06-08 04:24:22
这个问题已经有了一个答案：
- EXCEL VBA自动筛选除三个外3个答案
此代码利用find()根据数组中包含字符串值的A列的单元格值删除行。我的问题是，是否可以修改此代码，以便根据数组中的值删除行。
表面上，我认为这应该是一个简单的问题，但是从所有的搜索来看，VBA似乎缺乏一种直观的方法来使用<>Array()作为过滤/删除数据的标准。
Sub Find_Example()
Dim calcmode As Long
Dim ViewMode As Long
Dim myStrings As Variant
Dim FoundCell As Range
Dim I As Long
Dim myRng As Range
Dim sh As Worksheet
With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'We use the ActiveSheet but you can also use Sheets("MySheet")
Set sh = ActiveSheet
'We search in column A in this example
Set myRng = sh.Range("A:A")
'Add more search strings if you need
myStrings = Array("Ron", "Dave", "Tom")
With sh
'We select the sheet so we can change the window view
.Select
'If you are in Page Break Preview Or Page Layout view go
'back to normal view, we do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, we do this for speed
.DisplayPageBreaks = False
'We will search the values in MyRng in this example
With myRng
For I = LBound(myStrings) To UBound(myStrings)
Do
Set FoundCell = myRng.Find(What:=myStrings(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'Use xlPart If you want to search in a part of the FoundCell
'If you use LookIn:=xlValues it will also delete rows with a
'formula that evaluates to "Ron"
If FoundCell Is Nothing Then
Exit Do
Else
FoundCell.EntireRow.Delete
End If
Loop
Next I
End With
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With
End Sub回答 2
Stack Overflow用户
发布于 2018-06-08 13:19:09
有一种方法。如果数组太大，它就会中断(但可以将其放置在一个范围内，然后使用范围地址)
Dim rng As Range, arr, res, f, x
arr = Array("B", "D")
'set range to check (one column only)
With ActiveSheet
Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
f = "IFERROR(MATCH(" & rng.Address(False, False) & _
",{""" & Join(arr, """,""") & """},0),0)"
Debug.Print f
res = rng.Parent.Evaluate(f) '<< an array where "no match"=0
For x = rng.Cells.Count To 1 Step -1
If res(x, 1) = 0 Then rng.Cells(x).EntireRow.Delete
Next xStack Overflow用户
发布于 2018-06-08 14:19:57
用更新的代码编辑以避免循环
这看起来应该管用，但我还没试过.
Sub Find_Example()
Dim calcmode As Long
Dim ViewMode As Long
Dim myStrings As Variant
Dim FoundCell As Range
Dim I As Long
Dim myRng As Range
Dim sh As Worksheet
With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'We use the ActiveSheet but you can also use Sheets("MySheet")
Set sh = ActiveSheet
'We search in column A in this example
Set myRng = Intersect(sh.Range("A:A"))
'Add more search strings if you need
myStrings = Array("Ron", "Dave", "Tom")
With sh
'We select the sheet so we can change the window view
.Select
'If you are in Page Break Preview Or Page Layout view go
'back to normal view, we do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, we do this for speed
.DisplayPageBreaks = False
'tighten search range
Set myRng = Intersect(myRng, sh.UsedRange)
'We will search the values in MyRng in this example
With myRng
Dim deleteRow As Boolean
For Z = .Cells.Count to 1 Step -1
deleteRow = True
For x = LBound(myStrings) To UBound(myStrings)
If myRng.Cells(Z, 0).Value = myStrings(x) Then
deleteRow = False
Exit For
End If
Next x
If deleteRow Then .Cells(Z, 0).EntireRow.Delete
Next Z
End With
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/-100004801
复制相关文章
相似问题
腾讯云开发者
