时间戳

首页 > 解决方案 > 查找并选择查找结果，直到下一次查找

excel - 查找并选择查找结果，直到下一次查找

问题描述

基本上，我正在编写一个在主工作表中查找文本的代码，在找到需要从该单元格单元中选择的管理员后，我正在寻找“管理员”，然后在单独的工作表中查找并粘贴。

我尝试了不同的方法，但现在可以了，有什么建议吗？

例子

Sub FindNext_Example()
Dim FindValue As String
FindValue = "Bangalore"
Dim Rng As Range
Set Rng = Range("A2:A11")
Dim FindRng As Range
Set FindRng = Rng.Find(What:=FindValue)
Dim FirstCell As String
FirstCell = FindRng.Address

Do
Range(FristCell).Select
Selection.Copy
Worksheets.Add
ActiveSheet.Paste
Sheets("Sheet0").Select
Set FindRng = Rng.FindNext(FindRng)
Loop While FirstCell <> FindRng.Address

MsgBox "Search is over"

End Sub

例子
主表示例

查找并选择查找行直到下一次查找的示例
查找并选择查找行直到下一次查找的示例

粘贴在新工作表中
粘贴在新工作表中

下一个发现
下一个发现

直到最后

标签： excelvba

解决方案

试试这个代码：

Sub SubChopList()
    
    'Declarations.
    Dim DblColumnOffset As Double
    Dim RngSource As Range
    Dim RngSearch As Range
    Dim RngTop As Range
    Dim RngBottom As Range
    Dim StrSearch As String
    Dim StrDestinationAddress As String
    Dim WksSource As Worksheet
    
    'Settings.
    Set WksSource = ActiveSheet
    Set RngSource = WksSource.Range("A1")
    Set RngSource = Range(RngSource, RngSource.End(xlDown).End(xlToRight))
    
    'Setting DblColumnOffset equal to the offset from the first column of RngSource and the column to be searched.
    DblColumnOffset = 2
    
    'Setting the column to be searched.
    Set RngSearch = RngSource.Columns(1).Offset(0, DblColumnOffset)
    
    'Setting the value to be searched.
    StrSearch = "Admin"
    
    'Setting the address of the cell where the data will be pasted in the new sheets.
    StrDestinationAddress = "A1"
    
    'Setting RngTop as the first cell that contains StrSearch after the first cell of RngSearch.
    Set RngTop = RngSearch.Find(What:=StrSearch, _
                                After:=RngSearch.Cells(1, 1), _
                                LookIn:=xlValues, _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False, _
                                SearchFormat:=False _
                               )
    
    'Setting RngBottom as the cell in the row upon the first cell that contains StrSearch after RngTop.
    Set RngBottom = RngSearch.Find(What:=StrSearch, _
                                   After:=RngTop, _
                                   LookIn:=xlValues, _
                                   LookAt:=xlPart, _
                                   SearchOrder:=xlByRows, _
                                   SearchDirection:=xlNext, _
                                   MatchCase:=False, _
                                   SearchFormat:=False _
                                  ).Offset(-1, 0)
    
    'Repeating until the last block is reached.
    Do
        'Creating a new sheet.
        Worksheets.Add
        
        'Copy-pasting the block delimited by RngTop and RngBottom in the new sheet at the address specified in StrDestinationAddress.
        WksSource.Range(RngTop, RngBottom).Offset(0, -DblColumnOffset).Resize(, RngSource.Columns.Count).Copy Range(StrDestinationAddress)
        
        'Setting RngTop as the first cell that contains StrSearch after RngBottom.
        Set RngTop = RngSearch.Find(What:=StrSearch, _
                                    After:=RngBottom, _
                                    LookIn:=xlFormulas, _
                                    LookAt:=xlPart, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False, _
                                    SearchFormat:=False _
                                   )
        
        'Setting RngBottom as the cell in the row upon the first cell that contains StrSearch after RngTop.
        Set RngBottom = RngSearch.Find(What:=StrSearch, _
                                       After:=RngTop, _
                                       LookIn:=xlValues, _
                                       LookAt:=xlPart, _
                                       SearchOrder:=xlByRows, _
                                       SearchDirection:=xlNext, _
                                       MatchCase:=False, _
                                       SearchFormat:=False _
                                      ).Offset(-1, 0)
        
    Loop Until RngTop.Row > RngBottom.Row
    
    'Reporting the last block as did for all the previous blocks in the Do Loop cycle.
    Set RngBottom = RngSearch.Cells(RngSearch.Rows.Count, 1)
    Worksheets.Add
    WksSource.Range(RngTop, RngBottom).Offset(0, -DblColumnOffset).Resize(, RngSource.Columns.Count).Copy Range(StrDestinationAddress)
    
End Sub

选择包含要截断的数据的工作表并运行它。

推荐阅读