根据通用ID查找文本

时间:2018-02-05 15:46:24

标签: excel vba excel-vba

我正在尝试根据常用短语查找文字。问题是,我需要复制的文本在我将要搜索的文本下面。例如:

  

7。亚马逊通过电子邮件发送卖家

     

2018年2月2日,星期五

“亚马逊通过电子邮件发送的卖家”将保持一致,但我需要低于它的日期。

另一个例子:

  

索赔金额:

     

14.97

“索赔金额:”将保持一致,但我需要低于它的金额。

最后我想创建一个宏(如果宏不可能的VBA功能,我为不知道道歉),这将允许我搜索“索赔额:”/“亚马逊通过电子邮件发送的卖家”或另一个常见的短语然后将其下方单元格的内容移动到另一个工作簿中的另一个单元格。我不会有一个单元格位置供搜索引用,因为我每次导出的信息都会以不同方式粘贴到Excel中。

如果您有任何疑问或我应该澄清任何问题,请与我们联系。我是这个网站的新手,并不完全确定如何使我的问题尽可能清楚。我提前道歉。

谢谢!

3 个答案:

答案 0 :(得分:1)

这是一种使用

的快速方法
  • 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   

答案 1 :(得分:0)

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

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

如果您不知道文本将出现在哪个列中,则需要对每个可能的列进行匹配或更改您的方法(可能是辅助列)。

答案 2 :(得分:0)

您可以一次性过滤所需数据库中的所有数据库,然后获取过滤后的行上的单元格

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