[英]How do I use Excel VBA to filter 1 criteria across 2 columns?
我在A列和B列中有两列儿童名字。他们代表一对一起工作过的孩子。
我想过滤“Bob”与其他孩子一起工作的所有行。 所以我想过滤所有行,其中1个标准(Bob)显示在A列或B列中。
我想将这些行或一对孩子放入一个数组中。 我该怎么做呢?
我还没有看到道格在联盟范围内的回答。 但这是一个例子。 这使用Autofilter
而不是循环范围。 我已对代码进行了评论,因此您不应该对它有所了解。
码
Sub Sample()
Dim ws As Worksheet
Dim rng As Range, rngA As Range, rngB As Range
Dim Lrow As Long
Set ws = Sheets("Sheet1")
With ws
'~~> Get last row of Col A
Lrow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Identify the range
Set rng = .Range("A1:B" & Lrow)
.AutoFilterMode = False
'~~> Identify the range in Col A Which has BOB
With rng
.AutoFilter Field:=1, Criteria1:="Bob"
Set rngA = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
End With
.AutoFilterMode = False
'~~> Identify the range in Col B Which has BOB
With rng
.AutoFilter Field:=2, Criteria1:="Bob"
Set rngB = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
End With
.AutoFilterMode = False
'~~> Hide All except the Header row
rng.Offset(1, 0).EntireRow.Hidden = True
'~~> Unhide the rows which have Bob
Union(rngA, rngB).EntireRow.Hidden = False
End With
End Sub
屏幕截图
请尝试以下代码。 它会创建一个便笺本表,复制任何列中包含Bob的行,从结果中创建一个数组,然后删除便笺簿。
Sub GetBobRows()
Dim src As Worksheet
Dim tgt As Worksheet
Dim rng As Range
Dim cell As Range
Dim lastRow As Long
Dim bobCount As Long
Dim bobRow As Long
Set src = ActiveSheet
Sheets.Add
ActiveSheet.Name = "Scratchpad"
Set tgt = ActiveSheet
' assumes two columns with Bob data are A and B and start in row 1
' of the activesheet
lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
Set rng = src.Range("A1:A" & lastRow)
bobCount = 1
For Each cell In rng
If cell.Value = "Bob" Or cell.Offset(, 1).Value = "Bob" Then
bobRow = cell.Row
tgt.Range("A" & bobCount & ":B" & bobCount).Value = _
src.Range("A" & bobRow & ":B" & bobRow).Value
bobCount = bobCount + 1
End If
Next
Call CreateBobArray(tgt)
DeleteScratchpad
End Sub
Sub CreateBobArray(tgt As Worksheet)
Dim vaBobs As Variant
Dim lRow As Long
lRow = tgt.Range("A" & tgt.Rows.Count).End(xlUp).Row
'Read the data from the scratch pad into the bob array
vaBobs = tgt.Range("A1:B" & lRow).Value
End Sub
Sub DeleteScratchpad()
Application.DisplayAlerts = False
Sheets("Scratchpad").Delete
Application.DisplayAlerts = True
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.