Excel Visual Basic列转换宏处理千列数据过慢，求优化方法

原代码性能瓶颈分析 #

你的宏处理1000+列耗时极长，核心问题在于频繁调用Excel对象模型的剪切、删除操作：

• 每处理一对qty-code列，就要执行Cut、Delete这类界面交互操作，Excel会实时刷新屏幕、重新计算，单次操作开销极大
• 1000+列需要循环500次以上，累计开销被放大，直接导致耗时数小时

优化思路：内存数组批量处理 #

最优方案是把所有数据加载到VBA内存数组中，在内存里完成格式重组，最后一次性写入工作表。这种方式完全避免了频繁的Excel界面操作，性能提升会非常显著。

优化后的完整代码 #

Sub ConvertToLongFormat()
    Dim ws As Worksheet
    Dim originalData As Variant
    Dim resultData As Variant
    Dim lastRow As Long, lastCol As Long
    Dim pairCount As Integer
    Dim i As Long, j As Integer, k As Long
    
    ' 指定操作的工作表，可修改为具体工作表名如ThisWorkbook.Sheets("原始数据")
    Set ws = ActiveSheet
    
    ' 禁用Excel后台冗余操作，大幅提速
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' 获取原始数据的行列数
    lastRow = ws.UsedRange.Rows.Count
    lastCol = ws.UsedRange.Columns.Count
    
    ' 计算qty-code对的总数量（总列数减去日期列，除以2）
    pairCount = (lastCol - 1) \ 2
    
    ' 初始化结果数组：行数=原始行数×对数，列数固定为3（date,qty,code）
    ReDim resultData(1 To lastRow * pairCount, 1 To 3)
    
    ' 把原始数据一次性加载到内存数组
    originalData = ws.UsedRange.Value
    
    ' 填充结果数组
    k = 1 ' 结果数组的行指针
    For j = 1 To pairCount
        ' 计算当前qty和code列的位置
        Dim qtyCol As Integer, codeCol As Integer
        qtyCol = 2 + (j - 1) * 2
        codeCol = qtyCol + 1
        
        ' 遍历每一行原始数据，填充到结果数组
        For i = 1 To lastRow
            resultData(k, 1) = originalData(i, 1) ' 日期
            resultData(k, 2) = originalData(i, qtyCol) ' 数量
            resultData(k, 3) = originalData(i, codeCol) ' 编码
            k = k + 1
        Next i
    Next j
    
    ' 清空原工作表内容（若不想覆盖原数据，可改为写入新工作表）
    ws.Cells.Clear
    
    ' 把结果数组一次性写入工作表
    ws.Range("A1:C" & UBound(resultData, 1)).Value = resultData
    
    ' 恢复Excel原始设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    MsgBox "格式转换完成！"
End Sub

代码说明 #

1. 禁用后台操作：关闭屏幕更新、自动计算和事件触发，避免Excel在处理过程中做额外的冗余工作
2. 内存数组操作：把所有数据读到originalData数组，在内存里重组为resultData数组，全程不操作工作表单元格，彻底消除界面交互开销
3. 批量写入：最后一次性把结果数组写入工作表，只做一次IO操作
4. 自适应适配：自动计算qty-code对的数量，不管有多少对列都能处理

额外建议 #

• 若不想覆盖原数据，可将结果写入新工作表，只需修改Set ws = ActiveSheet为Set ws = ThisWorkbook.Sheets.Add即可
• 该方案处理超大数据量时依然能保持极高速度，1000+列的处理时间可压缩到几秒内

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