|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub Filter2()
- Dim arr
- Dim brr()
- Dim m%, n%
- With Worksheets("表1")
- arr = .Range("A2:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
- End With
- ReDim brr(1 To UBound(arr), 1 To 2)
- For m = 1 To UBound(arr)
- If (Right(arr(m, 1), 1) = "T" Or Right(arr(m, 1), 1) = "W") And arr(m, 2) > 0 Then
- n = n + 1
- brr(n, 1) = arr(m, 1)
- brr(n, 2) = arr(m, 2)
- End If
- Next
- ' ReDim Preserve brr(1 To n)
- Application.ScreenUpdating = False
- With Worksheets("表2")
- .Range("A2").CurrentRegion.Offset(1).ClearContents
- .Range("A2").Resize(n, 2).Value = brr
- End With
- Application.ScreenUpdating = True
- End Sub
复制代码
A、B两列都显示的代码 |
|