在当前excel中用vba代码实现：用“数据源”工作表中b列第2行到最大数据行内容作为查找的关键词，用关键词去“w附注”工作表查找关键词所在位置，其所在位置后两行开始到第一个合计行结束的表格内容作为区域1，合计行内容作为区域2，分别复制区域1和区域2的内容，分别数值粘贴到“附注”工作表的指定位置1和指定位置2，指定位置1的起始单元格位置集合在“数据源”工作表d列第2行到最大数据行，指定位置2的起始单元格位置集合在“数据源”工作表f列第2行到最大数据行。循环全部关键词，每个关键词需要的区域和位置都不同

以下是一个可能的 VBA 代码示例来解决您的问题： ```vb Sub CopyData() Dim lastRowSrc As Long, lastRowW As Long Dim i As Long Dim key As String Dim findRange As Range Dim startRow1 As Long, startRow2 As Long Dim endRow1 As Long, endRow2 As Long Dim destStartCell1 As Range, destStartCell2 As Range '获取“数据源”工作表 B 列数据的最大行数 lastRowSrc = Sheets("数据源").Cells(Rows.Count, "B").End(xlUp).Row '获取“w 附注”工作表数据的最大行数 lastRowW = Sheets("w 附注").Cells(Rows.Count, 1).End(xlUp).Row '遍历“数据源”工作表 B 列的每个关键词 For i = 2 To lastRowSrc key = Sheets("数据源").Cells(i, "B").Value '在“w 附注”工作表中查找关键词 Set findRange = Sheets("w 附注").Columns(1).Find(key, LookIn:=xlValues) If Not findRange Is Nothing Then '确定区域 1 的起始行和结束行 startRow1 = findRange.Row + 2 endRow1 = FindSumRow(Sheets("w 附注"), startRow1) - 1 '确定区域 2 的行 endRow2 = FindSumRow(Sheets("w 附注"), startRow1) '获取“数据源”工作表中指定位置 1 和 2 的起始单元格 Set destStartCell1 = Sheets("数据源").Cells(i, "D") Set destStartCell2 = Sheets("数据源").Cells(i, "F") '复制并粘贴区域 1 的值 Sheets("w 附注").Range(Sheets("w 附注").Cells(startRow1, 1), Sheets("w 附注").Cells(endRow1, Sheets("w 附注").Columns.Count)).Copy destStartCell1.PasteSpecial xlPasteValues '复制并粘贴区域 2 的值 Sheets("w 附注").Rows(endRow2).Copy destStartCell2.PasteSpecial xlPasteValues End If Next i End Sub Function FindSumRow(sheet As Worksheet, startRow As Long) As Long Dim i As Long For i = startRow To sheet.Rows.Count If sheet.Cells(i, 1).Value = "合计" Then FindSumRow = i Exit Function End If Next i End Function ``` 此代码假设“合计”字样在第一列中，并且数据的格式相对规范。在实际使用前，请根据您的具体数据情况进行适当的调整和测试。 [2024-10-11 17:16:08 | AI写代码神器 | 636点数解答]