求VBA代码：移除单元格中所在列表头内容并输出至新工作表

针对50000行1200列的大工作表，以下VBA代码通过数组批量处理数据（避免逐单元格操作的低效问题），严格满足保留表头、移除列内其他单元格的对应表头内容、输出到Sheet2的要求，且不依赖特定字符匹配：

Sub CleanDataToSheet2()
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim dataArr As Variant, cleanedArr As Variant
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long
    Dim headerText As String
    
    ' 设置源工作表和目标工作表
    Set srcWS = ThisWorkbook.Sheets("Sheet1") ' 替换为你的源工作表名称
    Set destWS = ThisWorkbook.Sheets("Sheet2")
    
    ' 清空目标表原有内容
    destWS.Cells.Clear
    
    ' 获取源表数据范围并读取到数组
    lastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row
    lastCol = srcWS.Cells(1, srcWS.Columns.Count).End(xlToLeft).Column
    dataArr = srcWS.Range(srcWS.Cells(1, 1), srcWS.Cells(lastRow, lastCol)).Value
    
    ' 初始化清理后的数组
    ReDim cleanedArr(1 To lastRow, 1 To lastCol)
    
    ' 复制表头到目标数组
    For j = 1 To lastCol
        cleanedArr(1, j) = dataArr(1, j)
    Next j
    
    ' 遍历每一列处理数据
    For j = 1 To lastCol
        headerText = dataArr(1, j)
        If headerText <> "" Then ' 跳过空表头
            For i = 2 To lastRow
                ' 移除单元格中的表头内容（全局替换）
                cleanedArr(i, j) = Replace(dataArr(i, j), headerText, "", , vbTextCompare)
            Next i
        Else
            ' 空表头列直接复制原内容
            For i = 2 To lastRow
                cleanedArr(i, j) = dataArr(i, j)
            Next i
        End If
    Next j
    
    ' 将清理后的数组写入Sheet2
    destWS.Range(destWS.Cells(1, 1), destWS.Cells(lastRow, lastCol)).Value = cleanedArr
    
    MsgBox "数据清理完成，已输出至Sheet2", vbInformation
End Sub

代码说明 #

• 高效处理大表：通过将数据读取到数组中操作，避免了逐单元格读写的性能损耗，适配5万行1200列的规模
• 表头匹配规则：对每一列的非表头单元格，全局移除该列的表头文本（不区分大小写，若需区分可将vbTextCompare改为vbBinaryCompare）
• 空表头兼容：若某列表头为空，直接保留该列所有内容
• 目标表清空：处理前自动清空Sheet2原有内容，避免数据残留

示例效果 #

原表（Sheet1）示例片段

处理后表（Sheet2）示例片段

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