根据通用 ID 查找文本

Question

我正在尝试根据常用短语查找文本。问题是，我需要复制的文本低于我将要搜索的文本。例如：

7。亚马逊给卖家发邮件

2018 年 2 月 2 日，星期五

“亚马逊电子邮件卖家”将是一致的，但我需要它下面的日期。

另一个例子：

索赔金额：

14.97

“索赔金额：”将是一致的，但我需要低于它的金额。

最后我想创建一个宏（或 VBA 函数，如果宏不可能，我很抱歉不知道），这将允许我搜索“索赔金额：”/“亚马逊电子邮件卖家”或其他常见的短语，然后将其下方单元格的内容移动到另一个工作簿中的另一个单元格。我没有单元格位置供搜索参考，因为我导出的信息每次都以不同的方式粘贴到 Excel 中。

如果您有任何问题或者我需要澄清什么，请告诉我。我是这个网站的新手，不完全确定如何尽可能清楚地表达我的问题。提前致歉。

谢谢！

Answer 1

这是一种使用 a 的快速方法

• A) 数据字段数组 而不是Range （A 列中假定的基本数据）。
• B) 所有找到的结果都写回到一对列中，您可以将其更改为任何其他范围或新工作簿。

代码

Option Explicit

Sub extract()
' declare and assign variables
  Dim header()
      header = Array("Amazon emailed seller", "Claim Amount") ' headers
  Dim ws As Worksheet                                   ' sheet object (objects have to be SET)
  Dim v                                                 ' variant datafield array
  Dim i  As Long, ii As Long, h As Long, n  As Long     ' counters
  Set ws = ThisWorkbook.Worksheets("MySheet")           ' << change to your sheet name
  n = ws.Range("A" & ws.Rows.Count).End(xlUp).Row       ' get last row in column A
' A) create datafield array and  loop through items
  v = Application.Transpose(ws.Range("A1:B" & n).Value) ' fill 1-based 2-dim datafield array (TWO Columns!)
  For i = 1 To n                                          ' loop through array "row"-items
    For h = LBound(header) To UBound(header)            ' loop through header items
      If InStr(v(1, i), header(h)) Then                 ' check search string against base text
         ii = ii + 1                                    ' increment array counter
         v(1, ii) = v(1, i):  v(2, ii) = v(1, i + 1)    ' enter found values (both rows)
      End If
    Next h
  Next i
  ReDim Preserve v(1 To 2, 1 To ii)                     ' redimension array to actual items count
' -------------------------------------------
' B) Write back results (e.g. in columns D:E)           ' << change to ANY wanted pair of columns
' -------------------------------------------
  ws.Range("D:E") = ""                                  '    clear columns D:E to get result
  ws.Range("D1:E" & ii) = Application.Transpose(v)      '    write summary back to columns D:E
' C) Clear memory
  Set ws = Nothing
End Sub   

Answer 2

这假设您知道您要查找的文本将出现在 A1:A20 中的某处。

=INDEX(A1:A20,MATCH("Claim Amount:",A1:A20,0)+1)

如果您不知道文本将出现在哪一列，您需要对每个可能的列进行匹配或更改您的方法（可能是辅助列）。

Answer 3

您可以在想要的标题上一次性过滤所有数据库，然后在过滤后的行下方获取单元格

Option Explicit

Sub main()
    Dim dataToKeep As Range
    Dim headers As Variant

    headers = Array("*Amazon emailed seller", "Claim Amount*") 'list your headers (see asterisks for wild characters)

    With Worksheets("mySheetName") ' change "mySheetName" to your actual sheet name
        With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) 'reference its column A cells from row 1 down to last not empty one
            .AutoFilter Field:=1, Criteria1:=headers, Operator:=xlFilterValues ' filter reference cells on wnated headers
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 0 Then Set dataToKeep = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Offset(1) ' if any filtered cell then get their underlying cells
        End With
        .AutoFilterMode = False
    End With

    If Not dataToKeep Is Nothing Then
        ' code to handle all data underlying the searched "header" cells
    End If

End Sub