2

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

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

还有更多术语我想复制术语 A: Event 和术语 B: Laptop 之间的所有行并将其粘贴到新工作表中。我的代码正在做的是复制事件和计算机的所有组合之间的行。甚至计算机和事件之间的行也被复制（在本例中为数字和笔记本电脑）。 

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

编辑：代码格式。

4

2 回答 2

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
于 2012-07-11T01:29:18.500 回答
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”的工作表上找到“事件”的第一个实例和“笔记本电脑”的最后一个实例，并将所有这些数据复制到 B13 和新工作表中的后续单元格。

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

于 2012-07-05T06:19:08.280 回答