Question

我遇到了Excel的问题，我希望有人可以帮助我。

我有一张表格，其中列K＆amp; Q是许多标签。我想要做的是有一个函数或一个宏，或者让我能够查看所有这些标签并将包含特定单词的行复制到另一个工作表。

e.g。

       I           J        K          L         M           N              O     etc. 
1      blah        blah     funding    blah      blah        blah           blah
2      funding     blah     blah       blah      blah        blah           blah
3      blah        blah     blah       blah      blah        blah           blah
4      blah        blah     blah       blah      blah        blah           blah
5      blah        blah     blah       blah      blah        funding        blah
6      blah        blah     funding    blah      blah        blah           blah

A列到H列中还有其他信息，我还需要复制，但不想包含在搜索中。所以在这种情况下，我希望能够搜索标签'资金'，因此复制第1,2,5和1行。 6到不同的工作表。

这可能吗？

Answer 1

这是代码。我赞赏来自这个论坛的tompols（我的代码基于此）： http://en.kioskea.net/forum/affich-242360-copy-row-if-a-range-of-column-matches-a-value

<强>更新：使用 Jean-FrançoisCorbett实现的一些奇妙点来重写代码更有效（谢谢！）。我还在末尾添加了一个消息框，报告复制了多少行。

我自定义代码以执行您需要它执行的操作。运行宏时（确保不在表2上）会发生一个框。输入您要过滤的单词（在您的情况下为资金），它将通过K：Q查看包含它的单元格。当它找到与表2匹配时，它将复制整个列。

Sub customcopy()

Application.ScreenUpdating = False
Dim lastLine As Long
Dim findWhat As String
Dim toCopy As Boolean
Dim cell As Range
Dim i As Long
Dim j As Long

findWhat = CStr(InputBox("Enter the word to search for"))
lastLine = ActiveSheet.UsedRange.Rows.Count

j = 1
For i = 1 To lastLine
    For Each cell In Range("K1:Q1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets(2).Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

i = MsgBox(((j - 1) & " row(s) were copied!"), vbOKOnly, "Result")

Application.ScreenUpdating = True
End Sub

接受答案（我注意到你是新来的）：如果这对您有用，请点击左上方显示的箭头接受此答案。谢谢！

Answer 2

您可以按照以下步骤尝试recording a macro：

选择要搜索的列（K和Q，如果我理解的话）
使用示例代码执行搜索
复制找到的行
将其粘贴到其他工作表

有关如何清理代码的一些提示，请参阅here

基于对标记网格的搜索将行复制到另一个工作表

2 个答案: