Excel VBA实现跨工作表复制数据并以列值为子标题

修改后的完整代码 #

Sub CopyWithSubheadings()
    Dim wsData As Worksheet, wsResult As Worksheet
    Dim lastRow As Long, resultRow As Long
    Dim concatCol As Integer, i As Long, currentConcat As String
    
    ' 定义工作表和CONCAT列位置（此处假设CONCAT是Data表第10列，可根据实际调整）
    Set wsData = ThisWorkbook.Sheets("Data")
    Set wsResult = ThisWorkbook.Sheets("Result")
    concatCol = 10 ' 替换为实际CONCAT列的列号
    
    ' 清空Result表
    wsResult.Cells.Clear
    resultRow = 1 ' 初始化Result表起始行
    
    ' 获取Data表有效数据的最后一行
    lastRow = wsData.Cells(wsData.Rows.Count, concatCol).End(xlUp).Row
    
    ' 按CONCAT列分组处理数据
    currentConcat = ""
    For i = 2 To lastRow ' 假设第1行是表头，从第2行开始遍历数据
        ' 遇到新的CONCAT值时插入子标题
        If wsData.Cells(i, concatCol).Value <> currentConcat Then
            currentConcat = wsData.Cells(i, concatCol).Value
            ' 设置子标题格式（加粗+跨列合并）
            With wsResult.Cells(resultRow, 1)
                .Value = currentConcat
                .Font.Bold = True
                .Resize(1, 11).Merge ' 合并11列（对应复制的11列数据，列数调整需同步修改）
            End With
            resultRow = resultRow + 1
            
            ' 首次生成子标题时复制表头（不需要表头可删除这段）
            If resultRow = 2 Then
                wsData.Range(wsData.Cells(1, 3), wsData.Cells(1, 9)).Copy wsResult.Cells(resultRow, 1)
                wsData.Range(wsData.Cells(1, 11), wsData.Cells(1, 13)).Copy wsResult.Cells(resultRow, 8)
                wsData.Cells(1, 15).Copy wsResult.Cells(resultRow, 11)
                resultRow = resultRow + 1
            End If
        End If
        
        ' 复制当前行指定列到Result表，保留原格式
        wsData.Range(wsData.Cells(i, 3), wsData.Cells(i, 9)).Copy wsResult.Cells(resultRow, 1)
        wsData.Range(wsData.Cells(i, 11), wsData.Cells(i, 13)).Copy wsResult.Cells(resultRow, 8)
        wsData.Cells(i, 15).Copy wsResult.Cells(resultRow, 11)
        resultRow = resultRow + 1
    Next i
End Sub

关键说明 #

• CONCAT列配置：代码中concatCol = 10是假设CONCAT列在Data表第10列，需根据实际位置修改数值。
• 子标题格式：通过Font.Bold设置加粗，Resize(1,11).Merge实现跨列合并，列数需和你复制的总列数（11列）匹配。
• 表头控制：如果不需要保留表头，直接删除复制表头的代码段即可。
• 效率优化：仅遍历Data表的有效数据行，避免原整列复制带来的空行冗余问题。
• 格式保留：沿用Copy方法直接复制单元格，完整保留原数据的字体、颜色、单元格格式等。

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