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

我对VBA很陌生，截止date很短，所以如果我没有遵循所有的论坛指南，我很抱歉。 我会很乐意为您提供任何帮助！

目标：

1. searchSheet1的关键字（活动：，网站地址：，说明：，所有者：，估价：，子types和DATE_B 🙂
2. 一旦find关键字，偏移量（0,1）
3. 复制值
4. 在Sheet2上，标签列如下：Permit_Type，Permit_Date，Permit_Address，Permit_Desc，Owner和Permit_Val）
5. 将复制的值从Sheet1粘贴到适当的列
6. 重复脚本，直到找不到所有关键字Sheet1。 换句话说，在Sheet1中继续。

什么工作：

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

什么不行：

1. 脚本在find第一个值后停止

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

数据看起来像这样，大约100条logging中的大多数关键字在列A中，其余的在列E中 – 对不起，我无法提供更好的代表！

'Column A Column B Column C Column D Column E Column F Column GG '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: [phone] 'Owner: Jane Smith Phone: [phone] 'Contractor: ABC Contracting Phone: [phone] '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: [phone] 'Owner: Joe Smith Phone: [phone] 'Contractor: BCA Contracting Phone: [phone] '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 

Answer 1

首先，你应该几乎总是避免使用select; 将值存储在variables中或直接设置它们要快得多（而且时间更清晰）。

其次， Find将只返回search参数的第一个实例。 您将需要利用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 

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

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

UPDATE

考虑到你的数据（你刚刚发布的），我所共享的代码可以通过只search列A来提高效率，因为它似乎是你在寻找单词“活动”的地方。 在VBA中，还应该尝试将声明范围限制为数据源（在这种情况下，列A， A:A或更好的A1:A5000 ，或者存在多行数据）

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