Excel VBA具有多个搜索条件并循环，直到找到所有不同的结果 [英] Excel VBA with multiple search criteria and loop until all distinct results are found

查看：1167
本文介绍了Excel VBA具有多个搜索条件并循环，直到找到所有不同的结果的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我对VBA非常新鲜，截止时间非常短，所以如果我没有遵循所有的论坛指南，我们深表歉意。我会很乐意为您提供任何帮助！



目标：


  1. 搜索Sheet1的关键字（活动:,网站地址:,说明：，所有者:,估值：，子类型：和DATE_B :)

  2. 找到，offset（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. 脚本在第一个值之后停止发现

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



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

 '列A列B列C列D列E列F列GG 
'活动：B13-0217类型：BUILD-M子类型：门廊状态：ISSUED 
'
 
'包裹：DATE_B：09/13/2013 Sq Feet：
'网站地址：123 Main St 
'说明：天井盖150平方英尺
'申请人：ABC承包电话：123- 456-7890 
'业主：Jane Smith电话：123-456-7890 
'承包商：ABC承包电话：123-456-7890 
'入住人数：用途：类别：Insp区：
'Valua ：$ 3,200.00费用要求：$ 256.90费用Col：$ 256.90 Bal到期日：$ 0.00 
 
'活动：B13-0224类型：BUILD-M子类型：甲板状态：ISSUED 
'包裹：DATE_B： 09/27/2013 Sq Feet：
'网站地址：234 South St 
'说明：在建筑物东侧安装一个682平方英尺的甲板
'申请人：BCA承包电话：234 -567-1234 
'所有者：乔史密斯电话：234-567-1234 
'承包商：BCA承包电话：234-567-1234 
'入住：使用：类：Insp区： 
'估价：$ 28,000.00费用要求：$ 1,408.60费用Col：$ 1,408.60 Bal到期日：$ 0.00

下面是我拼接在一起的脚本。任何帮助将不胜感激！ 

  Sub Lafayette_Permit_arrangement_macro（）
 
'旨在安排每月Lafayette许可证
'数据，以便以更多
'可用的大规模导入格式提取和组织特定数据。 
 
 
'许可号
 Cells.Find（What：=Activity：，After：= ActiveCell，LookIn：= xlFormulas，_ 
 LookAt：= xlPart ，SearchOrder：= xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）.Offset（0，1）。选择
 Selection.Copy 
范围（O2 ）。选择
 ActiveSheet.Paste 
'许可类型
 Cells.Find（What：=Sub Type：，After：= ActiveCell，LookIn：= xlFormulas，_ 
 LookAt：= xlPart，SearchOrder：= xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）.Offset（0，1）。选择
 Selection.Copy 
范围（P2）。选择
 ActiveSheet.Paste 
'许可发布日期
 Cells.Find（什么：=DATE_B：，之后：= ActiveCell，LookIn：= xlFormulas，_ 
 LookAt：= xlPart，SearchOrder = = xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）.Offset（0，1）。选择
 Selection.Copy 
范围（Q2）。选择
 ActiveSheet.Paste 
'许可地址
 Cells.Find（Wh at：=站点地址：，之后：= ActiveCell，LookIn：= xlFormulas，_ 
 LookAt：= xlPart，SearchOrder：= xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat ：= False）.Offset（0，1）。选择
 Selection.Copy 
范围（R2）。选择
 ActiveSheet.Paste 
'许可说明
 Cells.Find（What：=Description：，After：= ActiveCell，LookIn：= xlFormulas，_ 
 LookAt：= xlPart，SearchOrder：= xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）.Offset（0，1）。选择
 Selection.Copy 
范围（S2）。选择
 ActiveSheet.Paste 
'允许所有者
 Cells.Find（What：=Owner：，After：= ActiveCell，LookIn：= xlFormulas，_ 
 LookAt：= xlPart，SearchOrder = = xlByRows，SearchDirection = = xlNext，_ 
 MatchCase：= False，SearchFormat：= False）.Offset（0，1）。选择
 Selection.Copy 
范围（T2）。选择
 ActiveSheet.Paste 
'许可值
 Cells.Find（What：=Valuation：，After：= ActiveCell，LookIn：= x lFormulas，_ 
 LookAt：= xlPart，SearchOrder：= xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）.Offset（0，1）。选择
 Selection.cop 
范围（U2）。选择
 ActiveSheet.Paste 
 
范围（O2：U2）。选择
 Application.CutCopyMode = False 
 Selection.Copy 
表格（Sheet2）。选择
范围（A2）。选择
 ActiveSheet.Paste 
表格（Sheet2）。 b $ b Range（A1）。选择
 
 Application.CutCopyMode = False 
'将PermitNo列添加到Sheet2 
 ActiveCell.FormulaR1C1 =Permit_No
范围（A1）选择
'将PermitType列添加到Sheet2 
 ActiveCell.FormulaR1C1 =Permit_Type
范围（B1）。选择
'将PermitDate列添加到Sheet2 
 ActiveCell.FormulaR1C1 =Permit_Date
 Range（C1）。选择
'将PermitAdd列添加到Sheet2 
 ActiveCell.FormulaR1C1 =Permit_Address
范围D1）。选择
'将PermitDesc列添加到Sheet2 
 ActiveCell。公式R1C1 =Permit_Desc
范围（E1）。选择
'将PermitOwner列添加到Sheet2 
 ActiveCell.FormulaR1C1 =Owner
 Range（F1）。 
'将PermitVal列添加到Sheet2 
 ActiveCell.FormulaR1C1 =Permit_Val
 Range（G1）。选择
 
 
 
 
 End Sub


解决方案

总是避免使用select;在变量中存储值或直接设置它们要快得多（有时更干净）。



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

  Dim searchResult As Range 
 Dim x As Integer 
 
x = 2 
 
'搜索活动并存储在范围
设置searchResult = Cells.Find（什么：=活动：，_ 
 LookIn：= xlFormulas，LookAt：= xlPart，SearchOrder：= xlByRows，_ 
 SearchDirection：= xlNext，MatchCase：= False，_ 
 SearchFormat：= False）
 
 '存储此单词第一次出现的地址
 firstAddress = searchResult.Address 
 Do 
 
'使用行号和列号$在O列中设置值b $ b单元格（x，15）= searchResult.Offset（0，1）.Value 
 
'增加计数器以转到下一行
x = x + 1 
 
'查找下一次活动的发生
设置searchResult = Cells.FindNext（searchResult）
 
'检查是否找到了一个值，而不是找到的第一个值
循环While Not searchResult是Nothing和firstAddress<> searchResult.Address

例如，搜索完成后，您将重置x到2，并为所有其他搜索参数重复相同的步骤。



由于@ user2140261发表了评论，您可以采取进一步的步骤，使上述成为一个功能，然后使用您的vba代码中的功能，或通过公式直接在电子表格中。



更新



鉴于您的数据（刚才发布），只要搜索列A即可使我共享的代码更有效率，因为您似乎正在寻找活动一词。在VBA中，您还应该尝试将声明的范围限制为数据的来源（在这种情况下，列A， A：A ，甚至更好， A1：A5000 ，或者存在多行数据）



因此，而不是使用单元格。找到，您应该使用范围并指出要搜索的区域，例如范围（A1：A5000）


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!

Goal:

  1. Search Sheet1 for keywords (Activity:, Site Address:, Description:, Owner:, Valuation:, Sub Type: and DATE_B:)
  2. Once keyword is found, offset (0,1)
  3. Copy value
  4. On Sheet2, label columns as such: Permit_Type, Permit_Date, Permit_Address, Permit_Desc, Owner and Permit_Val)
  5. Paste copied value from Sheet1 to the appropriate columns
  6. Repeat script until all keywords are no longer found Sheet1. In other words, continue throughout Sheet1.

What works:

  1. Creates column names on Sheet2
  2. Script copies and pastes the first values found

What doesn't work:

  1. 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

Data looks like this, about 100 records Most Keywords are in Column A, then the rest in Column E - sorry I couldn't provide a better respresentation!

 '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

Below is the script I pieced together. Any help would be greatly appreciated!

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

解决方案

First off, you should almost always avoid using select; storing values in variables or setting them directly is much faster (and cleaner at times).

Secondly, Find will only return the first instance of a searched parameter. You will need to utilize a combination of FindNext and 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.

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

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.

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.

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)

Therefore, instead of using Cells.Find, you should use range and indicate the area to be searched, e.g. Range("A1:A5000")

这篇关于Excel VBA具有多个搜索条件并循环，直到找到所有不同的结果的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
Office最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆