Excel VBA 具有多个搜索条件并循环，直到找到所有不同的结果

我对 VBA 非常陌生，并且截止日期非常短，因此如果我没有遵循所有论坛指南，我深表歉意。如果您能提供任何帮助，我将不胜感激！

Goal:

1. 在 Sheet1 中搜索关键字（活动：、站点地址：、描述：、所有者：、估价：、子类型：和 DATE_B：）
2. 一旦找到关键字，偏移量(0,1)
3. 复制值
4. 在 Sheet2 上，将列标记为：Permit_Type、Permit_Date、Permit_Address、Permit_Desc、Owner 和 Permit_Val）
5. 将复制的值从 Sheet1 粘贴到相应的列
6. 重复脚本，直到不再找到 Sheet1 中的所有关键字。换句话说，继续整个 Sheet1。

什么有效：

1. 在 Sheet2 上创建列名称
2. 脚本复制并粘贴找到的第一个值

什么不起作用：

1. 找到第一个值后脚本停止

已知问题：我最初将值复制/粘贴到范围 O2:U2 中的同一张 Sheet1 上。我很难删除此命令，因为我只需要将这些值粘贴到 Sheet2 上

数据是这样的，大约100条记录大多数关键字位于 A 列，然后其余的位于 E 列 - 抱歉，我无法提供更好的表示！

 'Column A    Column B     Column C    Column D    Column E      Column F Column G G         
 'Activity: B13-0217       Type:  BUILD-M   Sub Type:   Porch   Status: ISSUED
 '

 'Parcel:               DATE_B: 09/13/2013  Sq Feet:    
 'Site Address: 123 Main St                     
 'Description:  Patio cover 150 sqft                        
 'Applicant:    ABC Contracting         Phone:  123-456-7890        
 'Owner:    Jane Smith          Phone:  123-456-7890        
 'Contractor:   ABC Contracting         Phone:  123-456-7890        
 'Occupancy:        Use:        Class:      Insp Area:  
 'Valuation:    $3,200.00 Fees Req:     $256.90     Fees Col:   $256.90     Bal Due:    $0.00 

 'Activity: B13-0224    Type:  BUILD-M      Sub Type:   Deck    Status: ISSUED
 'Parcel:               DATE_B: 09/27/2013  Sq Feet:    
 'Site Address: 234 South St                        
 'Description:  Install a 682 sqft deck on the east side of the building                        
 'Applicant:    BCA Contracting         Phone:  234-567-1234        
 'Owner:    Joe Smith           Phone:  234-567-1234        
 'Contractor:   BCA Contracting         Phone:  234-567-1234        
 'Occupancy:        Use:        Class:      Insp Area:  
 'Valuation:    $28,000.00 Fees Req:        $1,408.60   Fees Col:   $1,408.60   Bal Due:    $0.00 

下面是我拼凑的脚本。任何帮助将不胜感激！

Sub Lafayette_Permit_arrangement_macro()

' This Macro is intended to arrange the monthly Lafayette Permit
' data so that specific data is extracted and organized in a more
' usable format for mass import.


'Permit Number
Cells.Find(What:="Activity:", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
    Selection.Copy
Range("O2").Select
    ActiveSheet.Paste
'Permit Type
 Cells.Find(What:="Sub Type:", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
    Selection.Copy
 Range("P2").Select
 ActiveSheet.Paste
'Permit Issue Date
 Cells.Find(What:="DATE_B:", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
    Selection.Copy
 Range("Q2").Select
 ActiveSheet.Paste
'Permit Address
 Cells.Find(What:="Site Address:", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
    Selection.Copy
  Range("R2").Select
  ActiveSheet.Paste
'Permit Description
 Cells.Find(What:="Description:", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
    Selection.Copy
 Range("S2").Select
 ActiveSheet.Paste
'Permit Owner
 Cells.Find(What:="Owner:", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
    Selection.Copy
 Range("T2").Select
 ActiveSheet.Paste
'Permit Value
 Cells.Find(What:="Valuation:", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
    Selection.Copy
 Range("U2").Select
 ActiveSheet.Paste

 Range("O2:U2").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Sheet2").Select
 Range("A2").Select
 ActiveSheet.Paste
 Sheets("Sheet2").Select
 Range("A1").Select

 Application.CutCopyMode = False
 'Add PermitNo column to Sheet2
 ActiveCell.FormulaR1C1 = "Permit_No"
 Range("A1").Select
 'Add PermitType column to Sheet2
 ActiveCell.FormulaR1C1 = "Permit_Type"
 Range("B1").Select
 'Add PermitDate column to Sheet2
 ActiveCell.FormulaR1C1 = "Permit_Date"
 Range("C1").Select
 'Add PermitAdd column to Sheet2
 ActiveCell.FormulaR1C1 = "Permit_Address"
 Range("D1").Select
 'Add PermitDesc column to Sheet2
 ActiveCell.FormulaR1C1 = "Permit_Desc"
 Range("E1").Select
 'Add PermitOwner column to Sheet2
 ActiveCell.FormulaR1C1 = "Owner"
 Range("F1").Select
'Add PermitVal column to Sheet2
 ActiveCell.FormulaR1C1 = "Permit_Val"
 Range("G1").Select




End Sub

首先，您几乎应该始终避免使用 select；将值存储在变量中或直接设置它们要快得多（有时也更干净）。

第二，Find只会返回搜索到的参数的第一个实例。您将需要结合使用FindNext以及一个用于查找给定范围内参数的所有实例的循环。鉴于这两个事实，我将使用以下内容更新代码。

Dim searchResult As Range
Dim x As Integer

x = 2

' Search for "Activity" and store in Range
Set searchResult = Cells.Find(What:="Activity:", _
                     LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
                     SearchDirection:=xlNext, MatchCase:=False, _
                     SearchFormat:=False)

' Store the address of the first occurrence of this word
firstAddress = searchResult.Address
Do

    ' Set the value in the O column, using the row number and column number
    Cells(x, 15) = searchResult.Offset(0, 1).Value

    ' Increase the counter to go to the next row
    x = x + 1

    ' Find the next occurence of "Activity"
    Set searchResult = Cells.FindNext(searchResult)

    ' Check if a value was found and that it is not the first value found
Loop While Not searchResult Is Nothing And firstAddress <> searchResult.Address

例如，搜索完成“活动”后，您可以将 x 重置为 2，并对所有其他搜索参数重复相同的步骤。

正如 @user2140261 评论的那样，您可以采取进一步的步骤将上述内容变成一个函数，然后在 vba 代码中使用该函数，或者通过公式直接在电子表格中使用该函数。

UPDATE

考虑到您的数据（您刚刚发布的），我共享的代码可以通过仅搜索 A 列来提高效率，因为它似乎是您正在寻找“活动”一词的位置。在 VBA 中，您还应该尝试将声明的范围限制为数据源（在本例中为 A 列，A:A，或者甚至更好，A1:A5000，或者无论存在多少行数据）

因此，不要使用Cells.Find，您应该使用范围并指示要搜索的区域，例如Range("A1:A5000")