用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 实现上述功能的代码： ```vb Sub FindAndCopyData() Dim wsOriginal As Worksheet Dim wsVerify As Worksheet Dim keyword1 As String Dim keyword2 As String Dim keyword3 As String Dim found1 As Boolean Dim found2 As Boolean Dim found3 As Boolean Dim row1 As Long Dim row2 As Long Dim row3 As Long Dim totalRow1 As Long Dim totalRow2 As Long Dim totalRow3 As Long Dim i As Long Set wsOriginal = Worksheets("w附注工作表") Set wsVerify = Worksheets("附注校验工作表") keyword1 = "利率衍生工具" keyword2 = "权益衍生工具" keyword3 = "其他衍生工具" found1 = False found2 = False found3 = False ' 查找关键词 For i = 1 To wsOriginal.Rows.Count If InStr(1, wsOriginal.Cells(i, 1).Value, keyword1) > 0 Then found1 = True row1 = i End If If InStr(1, wsOriginal.Cells(i, 1).Value, keyword2) > 0 Then found2 = True row2 = i End If If InStr(1, wsOriginal.Cells(i, 1).Value, keyword3) > 0 Then found3 = True row3 = i End If Next i ' 定位关键词下方的第一个合计行 If found1 Then For i = row1 + 1 To wsOriginal.Rows.Count If InStr(1, wsOriginal.Cells(i, 1).Value, "合计") > 0 Then totalRow1 = i Exit For End If Next i End If If found2 Then For i = row2 + 1 To wsOriginal.Rows.Count If InStr(1, wsOriginal.Cells(i, 1).Value, "合计") > 0 Then totalRow2 = i Exit For End If Next i End If If found3 Then For i = row3 + 1 To wsOriginal.Rows.Count If InStr(1, wsOriginal.Cells(i, 1).Value, "合计") > 0 Then totalRow3 = i Exit For End If Next i End If ' 复制数据 If found1 Then wsOriginal.Range("A" & row1 & ":G" & row1).Copy wsVerify.Range("A149").PasteSpecial xlPasteValues If found2 And row2 > row1 Then wsOriginal.Range("A" & row2 & ":G" & row2).Copy wsVerify.Range("A154").PasteSpecial xlPasteValues End If If found3 And row3 > row2 Then wsOriginal.Range("A" & row3 & ":G" & row3).Copy wsVerify.Range("A159").PasteSpecial xlPasteValues End If wsOriginal.Range("A" & totalRow1 & ":G" & totalRow1).Copy wsVerify.Range("A163").PasteSpecial xlPasteValues End If If found2 And Not found1 Then wsOriginal.Range("A" & row2 & ":G" & row2).Copy wsVerify.Range("A154").PasteSpecial xlPasteValues If found3 And row3 > row2 Then wsOriginal.Range("A" & row3 & ":G" & row3).Copy wsVerify.Range("A159").PasteSpecial xlPasteValues End If wsOriginal.Range("A" & totalRow2 & ":G" & totalRow2).Copy wsVerify.Range("A163").PasteSpecial xlPasteValues End If If found3 And Not found1 And Not found2 Then wsOriginal.Range("A" & row3 & ":G" & row3).Copy wsVerify.Range("A159").PasteSpecial xlPasteValues wsOriginal.Range("A" & totalRow3 & ":G" & totalRow3).Copy wsVerify.Range("A163").PasteSpecial xlPasteValues End If ' 在合计行下方重新查找 found1 = False found2 = False found3 = False For i = totalRow1 + 1 To wsOriginal.Rows.Count If InStr(1, wsOriginal.Cells(i, 1).Value, keyword1) > 0 Then found1 = True row1 = i End If If InStr(1, wsOriginal.Cells(i, 1).Value, keyword2) > 0 Then found2 = True row2 = i End If If InStr(1, wsOriginal.Cells(i, 1).Value, keyword3) > 0 Then found3 = True row3 = i End If Next i If found1 Then For i = row1 + 1 To wsOriginal.Rows.Count If InStr(1, wsOriginal.Cells(i, 1).Value, "合计") > 0 Then totalRow1 = i Exit For End If Next i End If If found2 Then For i = row2 + 1 To wsOriginal.Rows.Count If InStr(1, wsOriginal.Cells(i, 1).Value, "合计") > 0 Then totalRow2 = i Exit For End If Next i End If If found3 Then For i = row3 + 1 To wsOriginal.Rows.Count If InStr(1, wsOriginal.Cells(i, 1).Value, "合计") > 0 Then totalRow3 = i Exit For End If Next i End If ' 复制数据 If found1 Then wsOriginal.Range("A" & row1 & ":G" & row1).Copy wsVerify.Range("A174").PasteSpecial xlPasteValues If found2 And row2 > row1 Then wsOriginal.Range("A" & row2 & ":G" & row2).Copy wsVerify.Range("A179").PasteSpecial xlPasteValues End If If found3 And row3 > row2 Then wsOriginal.Range("A" & row3 & ":G" & row3).Copy wsVerify.Range("A184").PasteSpecial xlPasteValues End If wsOriginal.Range("A" & totalRow1 & ":G" & totalRow1).Copy wsVerify.Range("A188").PasteSpecial xlPasteValues End If If found2 And Not found1 Then wsOriginal.Range("A" & row2 & ":G" & row2).Copy wsVerify.Range("A179").PasteSpecial xlPasteValues If found3 And row3 > row2 Then wsOriginal.Range("A" & row3 & ":G" & row3).Copy wsVerify.Range("A184").PasteSpecial xlPasteValues End If wsOriginal.Range("A" & totalRow2 & ":G" & totalRow2).Copy wsVerify.Range("A188").PasteSpecial xlPasteValues End If If found3 And Not found1 And Not found2 Then wsOriginal.Range("A" & row3 & ":G" & row3).Copy wsVerify.Range("A184").PasteSpecial xlPasteValues wsOriginal.Range("A" & totalRow3 & ":G" & totalRow3).Copy wsVerify.Range("A188").PasteSpecial xlPasteValues End If End Sub ``` 额外需要注意的逻辑点： 1. 确保要操作的工作表名称准确无误，避免因名称错误导致操作错误的工作表。 2. 处理可能出现的找不到关键词或合计行的情况，添加适当的错误处理代码，避免程序崩溃。 3. 考虑数据量较大时的性能问题，优化查找和复制的算法。 [2024-12-18 14:43:55 | AI写代码神器 | 1928点数解答]