Question

我有一个工作表，在A列中有很多术语。我想搜索两个术语，例如术语A和术语B并复制两个术语之间的所有行并将其粘贴到新的表中。这两个术语可能在列中重复。我基本上面临以下问题的问题：每当我运行我的代码时，它也会复制术语B和术语A之间的行，这是不必要的。以下是我用于两个术语A和B的代码。例如，我的专栏A是

研究所事件工作电脑笔记本电脑数据事件数据格式计算机

以及更多条款我想复制术语A：事件和术语B：笔记本电脑之间的所有行并将其粘贴到新工作表中。我的代码正在做的是在事件和计算机的所有组合之间复制行。甚至复制计算机和事件之间的行（在本例中为图和笔记本电脑）。

Sub OpenHTMLpage_SearchIt()
    Dim Cell As Range, Keyword$, N%, SearchAgain As VbMsgBoxResult
    Dim ass As Variant
    Dim Cellev As Range, prakash$, P%, SearchAgaina As VbMsgBoxResult
    Dim asa As Variant


StartSearch:
    N = 1
    Keyword = "Event"

    If Keyword = Empty Then GoTo StartSearch
    For Each Cell In Range("A1:A500")
        If Cell Like "*" & Keyword & "*" Then

        ass = Cell.Address

        P = 1
        prakash = "Computer"
        If prakash = Empty Then GoTo StartSearch
            For Each Cellev In Range("A1:A500")
                If Cellev Like "*" & prakash & "*" Then
                    asa = Cellev.Address

                    Range(asa, ass).Select
                    Selection.Copy
                    Sheets.Add After:=Sheets(Sheets.Count)
                    Range("B13").Select
                    ActiveSheet.Paste

                    Worksheets("sheet1").Select
                    P = P + 1
                End If
            Next Cellev
            N = N + 1
        End If
    Next Cell

End Sub

编辑：代码格式化。

Answer 1

试试这个：

Sub DoEeeeeet(sheetName, termA, termB)

    Dim foundA As Range, _
        foundB As Range
    Dim newSht As Worksheet

    With Sheets(sheetName).Columns(1)
        Set foundA = .Find(termA)
        If Not foundA Is Nothing Then
            Set foundB = .Find(termB, after:=foundA, searchdirection:=xlPrevious)
        End If
    End With

    If foundA Is Nothing Or foundB Is Nothing Then
        MsgBox "Couldn't find " & IIf(foundA Is Nothing, termA, termB)
    Else
        Range(foundA, foundB).Copy
        Set newSht = Sheets.Add
        newSht.Range("B13").PasteSpecial
    End If

End Sub

您可以按如下方式调用它：

DoEeeeeet "Sheet1","Event","Laptop"

它将在名为“Sheet1”的工作表上找到“Event”的第一个实例和“Laptop”的最后一个实例，并将所有数据复制到新工作表中的B13和后续单元格。

这就是你想要的吗？或者您希望每个子范围以“事件”开头并以“笔记本电脑”结尾？

Answer 2

以下是适用于我的代码。这会将事件和笔记本电脑之间的所有内容复制并粘贴到新工作表中。然后再次搜索第二次，这次搜索将从下一行开始到第一次搜索。我希望我对此很清楚。

  Sub Star123()
   Dim rownum As Long
   Dim colnum As Long
   Dim startrow As Long
   Dim endrow As Long
   Dim lastrow As Long
   rownum = 1
   colnum = 1
   lastrow = Worksheets("Startsheet").Range("A65536").End(xlUp).Row
   With ActiveWorkbook.Worksheets("StartSheet").Range("a1:a" & lastrow)


   For rownum = 1 To lastrow
    Do
       If .Cells(rownum, 1).Value = "Event" Then
          startrow = rownum
       End If

       rownum = rownum + 1


   If (rownum > lastrow) Then Exit For

   Loop Until .Cells(rownum, 1).Value = "Laptop"
   endrow = rownum
   rownum = rownum + 1

   Worksheets("StartSheet").Range(startrow & ":" & endrow).Copy


   Sheets("Result").Select
   Range("A1").Select
   ActiveSheet.Paste


   Next rownum
   End With
   End Sub

搜索两个值并在循环中复制它们之间的所有内容

2 个答案: