用vba在w附注工作表查找三个关键词：1.利率衍生工具，2.权益衍生工具，3.其他衍生工具。判断是否有这三个关键词，若有：则定位三个关键词所在行和三个关键词下方第一个合计行，复制第一个关键词所在行到下一个关键词出现之前a至g列内容，数值粘贴至附注校验工作表a149单元格。复制第二个关键词所在行到下一个关键词出现之前a至g列内容，数值粘贴至附注校验工作表a154单元格。复制第三个关键词所在行到下一个关键词出现之前a至g列内容，数值粘贴至附注校验工作表a159单元格。复制合计行到a至g列内容，数值粘贴至附注校验工作表a163单元格。若只有一个关键词，判断是第一、第二还是第三个关键词，复制关键词所在行到第一个合计行出现之前a至g列内容，数值粘贴至附注校验工作表对应的a149、a154或者a159单元格，然后复制合计行到a至g列内容，数值粘贴至附注校验工作表a163单元格。然后在合计行下方部分，重新查找上方三个关键词，判断是第一、第二还是第三个关键词，按照上面的规则数值粘贴至附注校验工作表对应的a174、a179或者a184单元格，然后复制合计行到a至g列内容，数值粘贴至附注校验工作表a188

好的，我明白你的需求了。下面是一个VBA脚本，可以帮助你在Excel中完成这个任务。请确保你已经启用了Excel的开发工具选项卡，以便插入和运行VBA代码。 ```vba Sub FindAndCopyDerivatives() Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim keyword1 As String, keyword2 As String, keyword3 As String Dim keywordRange As Range Dim startRow As Long, endRow As Long, copyRow As Long Dim targetRow1 As Long, targetRow2 As Long, targetRow3 As Long, targetRow4 As Long Dim foundKeyword1 As Range, foundKeyword2 As Range, foundKeyword3 As Range Dim foundTotal1 As Range, foundTotal2 As Range ' 设置工作表 Set wsSource = ThisWorkbook.Sheets("附注") Set wsTarget = ThisWorkbook.Sheets("附注校验") ' 设置关键词 keyword1 = "利率衍生工具" keyword2 = "权益衍生工具" keyword3 = "其他衍生工具" ' 初始化目标行 targetRow1 = 149 targetRow2 = 154 targetRow3 = 159 targetRow4 = 163 ' 查找关键词 Set foundKeyword1 = wsSource.Columns(1).Find(What:=keyword1, LookIn:=xlValues, LookAt:=xlWhole) Set foundKeyword2 = wsSource.Columns(1).Find(What:=keyword2, LookIn:=xlValues, LookAt:=xlWhole) Set foundKeyword3 = wsSource.Columns(1).Find(What:=keyword3, LookIn:=xlValues, LookAt:=xlWhole) ' 处理找到的关键词 If Not foundKeyword1 Is Nothing Then Call ProcessKeyword(foundKeyword1, wsSource, wsTarget, targetRow1, targetRow4) End If If Not foundKeyword2 Is Nothing Then Call ProcessKeyword(foundKeyword2, wsSource, wsTarget, targetRow2, targetRow4) End If If Not foundKeyword3 Is Nothing Then Call ProcessKeyword(foundKeyword3, wsSource, wsTarget, targetRow3, targetRow4) End If ' 在合计行下方重新查找关键词 If Not foundTotal1 Is Nothing Then Set keywordRange = wsSource.Range(wsSource.Cells(foundTotal1.Row + 1, 1), wsSource.Cells(wsSource.Rows.Count, 1)) Set foundKeyword1 = keywordRange.Find(What:=keyword1, LookIn:=xlValues, LookAt:=xlWhole) Set foundKeyword2 = keywordRange.Find(What:=keyword2, LookIn:=xlValues, LookAt:=xlWhole) Set foundKeyword3 = keywordRange.Find(What:=keyword3, LookIn:=xlValues, LookAt:=xlWhole) If Not foundKeyword1 Is Nothing Then Call ProcessKeyword(foundKeyword1, wsSource, wsTarget, 174, 188) End If If Not foundKeyword2 Is Nothing Then Call ProcessKeyword(foundKeyword2, wsSource, wsTarget, 179, 188) End If If Not foundKeyword3 Is Nothing Then Call ProcessKeyword(foundKeyword3, wsSource, wsTarget, 184, 188) End If End If End Sub Sub ProcessKeyword(keywordCell As Range, wsSource As Worksheet, wsTarget As Worksheet, targetRow1 As Long, targetRow4 As Long) Dim startRow As Long, endRow As Long, copyRow As Long Dim foundTotal As Range startRow = keywordCell.Row Set foundTotal = wsSource.Range(wsSource.Cells(startRow, 1), wsSource.Cells(wsSource.Rows.Count, 1)).Find(What:="合计", LookIn:=xlValues, LookAt:=xlWhole) endRow = foundTotal.Row - 1 For copyRow = startRow To endRow wsSource.Range(wsSource.Cells(copyRow, 1), wsSource.Cells(copyRow, 7)).Copy wsTarget.Cells(targetRow1, 1).PasteSpecial Paste:=xlPasteValues targetRow1 = targetRow1 + 1 Next copyRow wsSource.Range(wsSource.Cells(foundTotal.Row, 1), wsSource.Cells(foundTotal.Row, 7)).Copy wsTarget.Cells(targetRow4, 1).PasteSpecial Paste:=xlPasteValues End Sub ``` 需要注意的逻辑点： 1. 关键词查找范围：确保关键词查找的范围正确，特别是在合计行下方重新查找时，避免重复查找。 2. 合计行的唯一性：假设每个关键词下方只有一个合计行，如果有多行合计，需要进一步处理。 3. 目标单元格的更新：确保目标单元格的行号在每次复制后正确更新，避免覆盖已有的数据。 希望这个脚本能帮到你！如果有任何问题或需要进一步调整，请告诉我。 [2024-12-18 14:32:49 | AI写代码神器 | 1106点数解答]