具有多个搜索条件的 Excel VBA 并循环直到找到所有不同的结果
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/20005997/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA with multiple search criteria and loop until all distinct results are found
提问by user2996946
I'm very new to VBA and have an extremely short deadline, so I apologize if I'm not following all forum guidelines. I'd be greatful for any help you can provide!
我对 VBA 非常陌生，而且截止日期非常短，所以如果我没有遵循所有论坛指南，我深表歉意。如果您能提供任何帮助，我将不胜感激！
Goal:
目标：
- Search Sheet1 for keywords (Activity:, Site Address:, Description:, Owner:, Valuation:, Sub Type: and DATE_B:)
- Once keyword is found, offset (0,1)
- Copy value
- On Sheet2, label columns as such: Permit_Type, Permit_Date, Permit_Address, Permit_Desc, Owner and Permit_Val)
- Paste copied value from Sheet1 to the appropriate columns
- Repeat script until all keywords are no longer found Sheet1. In other words, continue throughout Sheet1.
- 在 Sheet1 中搜索关键字（活动：、站点地址：、描述：、所有者：、估价：、子类型：和 DATE_B：）
- 一旦找到关键字，偏移量（0,1）
- 复制值
- 在 Sheet2 上，标记列如下：Permit_Type、Permit_Date、Permit_Address、Permit_Desc、Owner 和 Permit_Val）
- 将 Sheet1 中复制的值粘贴到相应的列
- 重复脚本，直到不再找到所有关键字 Sheet1。换句话说，继续整个 Sheet1。
What works:
什么工作：
- Creates column names on Sheet2
- Script copies and pastes the first values found
- 在 Sheet2 上创建列名
- 脚本复制并粘贴找到的第一个值
What doesn't work:
什么不起作用：
- Script stops after first values are found
- 找到第一个值后脚本停止
Known issue:I originally had the values copied/pasted on the same Sheet1 in Range O2:U2. I'm having a hard time removing this command since I just need these values to paste on Sheet2
已知问题：我最初将值复制/粘贴在范围 O2:U2 中的同一个 Sheet1 上。我很难删除此命令，因为我只需要将这些值粘贴到 Sheet2 上
Data looks like this, about 100 recordsMost Keywords are in Column A, then the rest in Column E - sorry I couldn't provide a better respresentation!
数据看起来像这样，大约 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: ,200.00 Fees Req: 6.90 Fees Col: 6.90 Bal Due: 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
.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: ,000.00 Fees Req: ,408.60 Fees Col: ,408.60 Bal Due: 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
.00
Below is the script I pieced together. Any help would be greatly appreciated!
下面是我拼凑的脚本。任何帮助将不胜感激！
##代码##采纳答案by Jaycal
First off, you should almost always avoid using select; storing values in variables or setting them directly is much faster (and cleaner at times).
首先，你应该几乎总是避免使用 select；将值存储在变量中或直接设置它们要快得多（有时也更干净）。
Secondly, Findwill only return the first instance of a searched parameter. You will need to utilize a combination of FindNextand a loop to find all instance of a parameter in a given range. Given these two facts, I would update the code with the following.
其次，Find将只返回搜索参数的第一个实例。您需要结合使用FindNext和 循环来查找给定范围内参数的所有实例。鉴于这两个事实，我将使用以下内容更新代码。
After the search is complete for "Activity", for example, you would then reset x to 2 and repeat the same steps for all your other search parameters.
例如，在“活动”的搜索完成后，您可以将 x 重置为 2，并对所有其他搜索参数重复相同的步骤。
As @user2140261 commented, you can take further steps to make the above into a function and then either use the function within your vba code, or directly in the spreadsheet via a formula.
正如@user2140261 评论的那样，您可以采取进一步的步骤将上述内容变成一个函数，然后在您的 vba 代码中使用该函数，或者通过公式直接在电子表格中使用。
UPDATE
更新
Given your data (which you just posted), the code I shared can be made more efficient by only searching Column A, since it seems to where you are looking for the word "Activity". In VBA, you should also try to limit your declared ranges to the source of the data (in this case, Column A, A:A, or even better, A1:A5000, or however many rows of data exist)
鉴于您的数据（您刚刚发布），我共享的代码可以通过仅搜索 A 列来提高效率，因为它似乎是您在寻找“活动”一词的地方。在 VBA 中，您还应该尝试将声明的范围限制为数据源（在这种情况下，A 列A:A，甚至更好，A1:A5000，或者存在多行数据）
Therefore, instead of using Cells.Find, you should use range and indicate the area to be searched, e.g. Range("A1:A5000")
因此，Cells.Find您应该使用 range 并指示要搜索的区域，而不是使用，例如Range("A1:A5000")
