excel - 如何使用 VBA 根据关键字匹配相应的单元格值?
问题描述
我有一个宏,可以网络抓取数据并将结果返回到单独的工作表。但是,必须处理这些结果,以便将所有标题提取到“搜索结果”部分的一列中。我不知道如何编写一个函数来返回与术语“TI”相关的所有值。我写了一些代码,但它不起作用。任何有关此的帮助或建议将不胜感激。
子返回结果()
Dim r As Range
Application.ScreenUpdating = False
With Worksheets("Search Results")
.AutoFilterMode = False
.Range("A:A").AutoFilter Field:=1, Criteria1:="=TI"
With .AutoFilter.Range
On Error Resume Next
Set r = .Resize(.Rows.Count - 1, 1).Offset(1,
2).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not r Is Nothing Then
r.Copy Worksheets("Search Results").Range("A7")
End If
End With
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub
解决方案
这应该是一个与您的偏差最小的工作代码(注释中的解释)
Option Explicit
Sub ReturnResults()
Dim r As Range
Application.ScreenUpdating = True
With Worksheets("Sheet1") ' reference results sheet
If IsEmpty(.Range("A1")) Then .Range("A1").Value = "dummy header" ' if A1 is empty, put a "dummy" header to make AutoFilter work properly
.AutoFilterMode = False
With .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).Offset(, -1) ' reference referenced sheet column A range from row 1 down to column B last not empty cell
.SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C" ' fill referenced range blank cells with the same value as the not empty cell above
.AutoFilter Field:=1, Criteria1:="=TI"
On Error Resume Next
Set r = .Resize(.Rows.Count - 1, 1).Offset(1, 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not r Is Nothing Then r.Copy Worksheets("Search Results").Range("B7")
.Parent.AutoFilterMode = False
.SpecialCells(xlCellTypeFormulas).ClearContents ' clear cell with formulas
If .Range("A1").Value = "dummy header" Then .Range("A1").ClearContents ' remove any "dummy" header
End With
End With
Application.ScreenUpdating = True
End Sub
推荐阅读
- javascript - 是否可以使用 Chrome 开发工具查看当前有多少事件侦听器处于活动状态?
- c# - ShotGun 传播统一 3d FPS 射击游戏
- unity3d - 注册了碰撞但标签错误:伤害
- hook - 加载 Linux 内核模块时,如何使用 `kallsyms_lookup_name` 函数修复`unknown character` 错误?
- python - 熊猫数据框中的(现有)列名未定义错误
- python - 将变量显示为图像
- c - 转换c时间函数delphi
- javascript - Gatsby 插件错误“未处理的拒绝减速器可能无法调度操作。”
- python - Pycharm 中的 Python 暂存文件 - 找不到模块?
- reactjs - 提供的 React SVG 标签名称无效