Question

我是VBA的新手，正在尝试编写代码在Excel中搜索字符串的地方。找到它（开始位置）后，搜索另一个字符串并找到它（结束位置），将这两个之间的所有行复制并复制到新的工作表中。

每行要复制的行也有3列，需要复制/粘贴。

我尝试在此处修改一些代码，从YouTube修改一些代码，但是没有任何运气。这是我到目前为止的代码。感谢您提供的任何帮助

Employee = Sheet1.Cells(5, 1)
TTI = Sheet1.Cells(3, 1)
Dim rng As Range
Dim Employee As String
Dim rownumber As Long

Set rng = Sheet1.Columns("A:A").Find(What:=Employee, _
    LookIn:=x1Formulas, LookAt:=x1Whole, SearchOrder:=x1byRows, _
    SearchDirection:=x1Next, MatchCase:=False, SearchFormat:=False)
    rownumber = rng.Row
    rng = Sheet1.Columns("rownumber,A:A").Find(What:=TTI, _
    LookIn:=x1Formulas, LookAt:=x1Whole, SearchOrder:=x1byRows, _
    SearchDirection:=x1Next, MatchCase:=False, SearchFormat:=False)
    rownumber2 = rng.Row

Sheet2.Cells(2, 1).String = Sheet.Cells("rownumber, 1:rownumber2, 1").String

当我尝试运行代码时，我得到的只是一个运行时错误

Answer 1

您可以将以下代码用作宏的模板，可能需要调整一些范围以适应您的需求。

Sub test()

    Dim iRowStart As Integer, iRowEnd As Integer, iCol As Integer

    iCol = 7

    iRowEnd = FindString("To", iCol)
    iRowStart = FindString("From", iCol)


    ActiveSheet.Range(Cells(iRowStart, iCol), Cells(iRowEnd, iCol)).Copy Destination:=Sheet2.Range("A2")
    ActiveSheet.Cells(iRowStart, 1).Select

End Sub


Function FindString(str As String, iCol As Integer) As Integer
    Dim c As Range
    Dim rSearch As Range

    Set rSearch = ActiveSheet.Columns(iCol)

    With rSearch
        Set c = .Find(str, LookIn:=xlValues)
        If Not c Is Nothing Then
            FindString = c.Row
        End If
    End With
End Function

在Excel文件中搜索2个字符串，然后复制并粘贴到新表中

1 个答案: