VBA宏修改请求：按关键词分行输出跨工作簿求和结果

你的宏当前会把所有城市的求和结果挤在同一行，要实现每个城市结果单独占一行，只需要调整目标单元格的移动逻辑，同时可以把城市名称也写入对应行的A列，让结果更清晰。修改后的代码如下：

Sub SumByKeyWords()
    ' 定义工作簿变量
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    ' 关联两个工作簿
    Set wb1 = Workbooks("forcast.xlsx")
    Set wb2 = Workbooks("kesz4.xlsm")
    
    ' 定义要搜索的关键词数组
    Dim keywords As Variant
    keywords = Array("Hamburg", "Berlin", "Munich")
    
    Dim destRange As Range
    ' 初始目标位置设为Sheet1的A列下一个空行
    Set destRange = wb2.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ' 遍历每个关键词
    Dim keyword As Variant
    For Each keyword In keywords
        ' 在源工作簿的A列查找关键词
        Dim keywordRow As Variant
        keywordRow = Application.Match(keyword, wb1.Worksheets("Sheet1").Range("A1:A10"), 0)
        
        If IsNumeric(keywordRow) Then
            ' 先把当前城市名称写入目标行的A列
            destRange.Value = keyword
            ' 切换到B列开始写入求和结果
            Set destRange = destRange.Offset(0, 1)
            
            ' 用With简化源工作表的引用
            With wb1.Worksheets("Sheet1")
                ' 遍历2到6列计算求和
                Dim colIndex As Integer
                For colIndex = 2 To 6
                    Dim sumValue As Variant
                    sumValue = Application.Sum(.Range(.Cells(keywordRow, colIndex), .Cells(keywordRow + 2, colIndex)))
                    destRange.Value = sumValue
                    ' 同一行内移动到下一列
                    Set destRange = destRange.Offset(0, 1)
                Next colIndex
            End With
            
            ' 处理完当前城市后，回到下一行的A列开头
            Set destRange = destRange.Offset(1, -(6 - 1)) ' 6-1是因为从B到F共5列，往左移5列回到A列，再下移一行
        End If
    Next keyword
End Sub

关键修改点： #

• 初始目标位置改为A列的空行，方便写入城市名称
• 每处理一个城市，先把城市名写入A列，再从B列开始放求和结果
• 处理完一个城市的所有列后，把目标单元格移到下一行的A列开头，而不是同一行的下一列
• 用With语句简化了源工作表的重复引用，让代码更简洁

内容的提问来源于stack exchange，提问作者Typo