我对VBA很新，截止日期非常短，所以如果我没有遵守所有论坛指南，我会道歉。我很乐意为您提供任何帮助！
目标：
什么有效：
什么行不通：
已知问题： 我最初在范围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
答案 0 :(得分：2)
首先，您几乎应该总是避免使用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代码中的函数，或直接通过公式在电子表格中使用。
<强>更新
鉴于您的数据（您刚发布的数据），我只通过搜索A列可以提高我共享的代码的效率，因为它似乎在您寻找单词“Activity”的位置。在VBA中，您还应该尝试将声明的范围限制为数据源（在本例中为A列，A:A，甚至更好，A1:A5000，或者存在多行数据）
因此，您应该使用范围并指明要搜索的区域，而不是使用Cells.Find。 Range("A1:A5000")