在 excel sheet 中搜索文本并将单元格范围提取到 table

Question

我经常需要从 excel sheet 中提取一些数据。大多数时候 sheet 足够小，可以单手执行此操作，这意味着，查找特定字符串并手动复制粘贴感兴趣的单元格。

Example of an excel sheet

这次我有一个超过 5000 行的文件，这使我不能像往常一样这样做。这是编写简单代码自动执行此操作的好时机。就我而言，最好的方法是：

1) 查找包含术语 "text"
2) 对于每个单元格：
- 2.1) Select 一系列单元格
- 2.2) 复制单元格范围并将其粘贴到此目标范围

因为我不习惯编码，所以我在网上搜索了一些具有类似行为的代码。到目前为止我发现的是 1) 步骤的代码。在以下代码中，单元格的地址写入目标范围：

Dim findWhat As String, address As String
Dim fsr As Range, rs As Range, fCount As Long

findWhat = InputBox("Enter what you want to find?", "Find what...")

If Len(findWhat) > 0 Then
    'clearFinds
    Set frs = Range("A1:AW6000")
    Set rs = frs.Find(What:=findWhat)
    If Not rs Is Nothing Then
        address = rs.address
        Do
            Range("bb1").Offset(fCount).Value = rs.Value
            Range("bc1").Offset(fCount).Value = rs.address
            Set rs = frs.FindNext(rs)
            fCount = fCount + 1
        Loop While Not rs Is Nothing And rs.address <> address
    End If
End If

关于步骤 2.1)，我知道我必须将此实现为 select 在步骤 1 中找到的每个单元格的范围):

Range(ActiveCell, ActiveCell.Offset(4, 9))

最后，我打算在步骤 2.2 中使用以下代码):

Worksheets("Sheet1").Range("A1:D4").Copy _ 
    destination:=Worksheets("Sheet2").Range("E5")

尽管我付出了努力，但我不知道如何正确编写代码才能使此代码正常工作。有人可以帮我一点忙吗？

Answer 1

试试这个。您可能需要调整目标范围以适应。

同时检查Find参数；特别是，您是要查找仅包含在输入框中输入的文本的单元格，还是可以包含其他文本的单元格（调整 lookat）。

Resize 位表示复制 5 行乘 10 列的范围，其中左上角的单元格是包含找到的文本的单元格。

Sub x()

Dim findWhat As String, s As String
Dim rs As Range, frs as Range

findWhat = InputBox("Enter what you want to find?", "Find what...")

If Len(findWhat) > 0 Then
    'clearFinds
    Set frs = Worksheets("Sheet1").Range("A1:AW6000")
    Set rs = frs.Find(What:=findWhat, Lookat:=xlPart, MatchCase:=False, SearchFormat:=False)
    If Not rs Is Nothing Then
        s = rs.address
        Do
            Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp)(2).Resize(5, 10).Value = rs.Resize(5, 10).Value
            Set rs = frs.FindNext(rs)
        Loop While rs.address <> s
    End If
End If

End Sub

在 excel sheet 中搜索文本并将单元格范围提取到 table

Search for text in excel sheet and extract range of cells to a table

excel

vba

copy-paste

range