VBA实现：在附注工作表查找关键词并精准复制数据至校验工作表

要实现这个功能，可以使用VBA（Visual Basic for Applications）编写一个宏。以下是一个示例代码，它实现了你所描述的逻辑： ```vba Sub CopyDerivativeData() Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim rng As Range Dim cell As Range Dim keywords(1 To 3) As String Dim keywordRows(1 To 3) As Long Dim totalRow As Long Dim i As Integer Dim targetRow As Long ' 设置关键词 keywords(1) = "利率衍生工具" keywords(2) = "权益衍生工具" keywords(3) = "其他衍生工具" ' 设置工作表 Set wsSource = ThisWorkbook.Sheets("附注") Set wsTarget = ThisWorkbook.Sheets("附注校验") ' 初始化变量 For i = 1 To 3 keywordRows(i) = -1 Next i totalRow = -1 ' 查找关键词和合计行 For Each cell In wsSource.Range("A:A") If cell.Value = keywords(1) Then keywordRows(1) = cell.Row If cell.Value = keywords(2) Then keywordRows(2) = cell.Row If cell.Value = keywords(3) Then keywordRows(3) = cell.Row If cell.Value = "合计" Then totalRow = cell.Row Next cell ' 复制数据到目标工作表 For i = 1 To 3 If keywordRows(i) <> -1 And totalRow <> -1 Then targetRow = 149 + (i - 1) * 5 wsSource.Range("A" & keywordRows(i) & ":G" & totalRow).Copy wsTarget.Range("A" & targetRow).PasteSpecial Paste:=xlPasteValues End If Next i ' 重新查找关键词并复制数据到目标工作表下方部分 For i = 1 To 3 If keywordRows(i) <> -1 And totalRow <> -1 Then targetRow = 174 + (i - 1) * 5 wsSource.Range("A" & keywordRows(i) & ":G" & totalRow).Copy wsTarget.Range("A" & targetRow).PasteSpecial Paste:=xlPasteValues End If Next i Application.CutCopyMode = False End Sub ``` 说明： 1. 关键词：定义了三个关键词 `利率衍生工具`、`权益衍生工具` 和 `其他衍生工具`。 2. 工作表：设置了源工作表为 `附注`，目标工作表为 `附注校验`。 3. 查找关键词和合计行：遍历源工作表的 A 列，找到每个关键词所在的行以及合计行的行号。 4. 复制数据到目标工作表：根据找到的行号，将对应的数据区域复制到目标工作表的指定位置。 5. 重新查找关键词并复制数据到目标工作表下方部分：再次查找关键词，并将数据复制到目标工作表的下方部分。 6. 清除剪贴板：最后清除剪贴板内容。 你可以将此代码粘贴到 VBA 编辑器中，然后运行该宏来实现所需的功能。 ######[AI写代码神器 | 824点数解答 | 2024-12-18 14:19:24]