Excel 查找并选择该查找，直到下一个查找

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

我尝试过不同的方法，但现在成功了，有什么建议吗

范例

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

子FindNext_示例（）
作为字符串的Dim FindValue
FindValue=“班加罗尔”
变暗Rng As范围
设置Rng=范围（“A2:A11”）
变暗FindRng As范围
设置FindRng=Rng.Find（内容：=FindValue）
将第一个单元格设置为字符串
FirstCell=FindRng.Address
做
范围（第一个单元格）。选择
选择，复制
工作表。添加
活动表。粘贴
图纸（“图纸0”）。选择
设置FindRng=Rng.FindNext（FindRng）
在FirstCell查找地址时循环
MsgBox“搜索结束”
端接头

示例

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

粘贴到新页中

下一个查找

在结束之前，请尝试以下代码：

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

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

创建标准工作表

• 调整常量部分中的值

代码

选项显式
子添加标准工作表（）
Const wsName As String=“Sheet1”
Const sCellAddress As String=“A1”
常量条件为String=“Admin*”
常量标准列的长度=3
常量dCellAddress为String=“A1”
将wb设置为工作簿：设置wb=ThisWorkbook
Application.ScreenUpdating=False
使用wb.Worksheets（wsName）.Range（sCellAddress）.CurrentRegion
.Worksheet.AutoFilterMode=False
.自动筛选条件列，条件
变暗rg As范围
关于转到特殊单元格错误
设置rg=.Columns（CriteriaColumn）.Resize（.Rows.Count-1）.Offset（1）_
.特殊单元格（xlCellTypeVisible）
错误转到0
长度为的Dim nCount:nCount=rg.Cells.Count
作为变量的Dim坐标：ReDim坐标（1到nCount，1到3）
Dim arg As范围
暗淡的cel As范围
长
对于rg.区域中的每个参数
对于arg.单元格中的每个单元格
n=n+1
坐标（n，1）=小区行
如果n>1，则
坐标（n-1，2）=坐标（n，1）-1
Coord（n-1，3）=Coord（n-1，2）-Coord（n-1，1）+2
如果结束
下一个细胞
下一个arg
n=n+1
坐标（n-1，2）=.Rows.Count
Coord（n-1，3）=Coord（n-1，2）-Coord（n-1，1）+2
.Worksheet.AutoFilterMode=False
长度为的Dim cCount:cCount=.Columns.Count
Dim数据作为变量：数据=.Value
作为变量的模糊结果
我长，j长，k长
对于n=1，要计算
重拨结果（1对Coord（n，3），1对Account）
当j=1时，计算
结果（1，j）=数据（1，j）
下一个j
k=1
对于i=坐标（n，1）到坐标（n，2）
k=k+1
当j=1时，计算
结果（k，j）=数据（i，j）
下一个j
接下来我
使用wb.Worksheets.Add（后面：=wb.Sheets（wb.Sheets.Count））
.Range（dCellAddress）.Resize（k，cCount）.Value=Result
以
下一个
.工作表.选择
以
程序出口：
Application.ScreenUpdating=True
出口接头
特殊电池：
恢复程序退出
端接头

我建议您展示您尝试过的内容，并解释您遇到了哪些错误，以及在哪里或在哪里遇到了问题。读书可能有助于树立一个好榜样。谢谢你的建议，我编辑了它并添加了代码谢谢，这真的很好谢谢@vbasic208这真的很好，但是如果我需要每个管理员都有单独的代码怎么办？因为在关闭文件之前，我将使用这些数据制作一些图表，所以我不知道每个单独的管理员的确切含义。而且，

做一些图表

也没什么帮助。如果该代码适用于此问题，则可以将其复制/粘贴到新问题中，并解释其功能，然后详细解释其功能。像你在这个问题中做的那样，包括相关的图片。你可以在你的评论中发布一个新问题的链接，这样那些正在回答这个问题的贡献者就可以看一看了。我的意思是不是用wb.Worksheets.Add替换

（后面：=wb.Sheets（wb.Sheets.Count））

用

替换wb.Worksheets.Add（1）

？