VBA代码：巧用“数据源”关键词在“w附注”找区域并复制到“附注”指定位置

以下是一个可能的 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 ``` 此代码假设“合计”字样在第一列中，并且数据的格式相对规范。在实际使用前，请根据您的具体数据情况进行适当的调整和测试。 ######[AI写代码神器 | 636点数解答 | 2024-10-11 17:16:08]