求助：VBA For Loop实现数据表转列复制粘贴及日期匹配

需求说明 #

• 从FCST工作表的F5单元格开始，逐列向下复制数据，依次粘贴到reFormFCST工作表的B列（从B2开始，后续数据接在下方），需覆盖F、G、E等所有目标列
• 复制每列数据对应的日期（推测为FCST中该列顶部的日期值），粘贴到reFormFCST的C列，且日期的行数要与对应数据的行数完全一致

原代码问题 #

当前代码无法进入后续处理环节，核心问题包括：

1. 列循环未使用变量r切换目标列，始终操作F5，无法遍历后续列
2. 粘贴位置固定为B3，每次操作会覆盖之前的数据
3. 日期循环无实际复制粘贴逻辑，未实现日期与数据行的匹配
4. 频繁使用Select方法，易出错且效率低下

原代码 #

Option Explicit

Sub formatData()
Dim i As Integer
Dim r As Integer
Dim j As Integer
Dim k As Integer
Dim l As Range
Dim f As Range

i = Range("F5").End(xlToRight).Column
k = Range("B5").End(xlDown).Row

'Regular For loop
For r = 6 To i
Sheets("FCST").Select
Range("F5").Select
Range(Selection, Selection.End(xlDown)).Copy
Sheets("reFormFCST").Select
Range("B3").PasteSpecial

'Dates For Loop
For j = 5 To k
Sheets("FCST").Select

Sheets("reFormFCST").Select

Next

Next

End Sub

工作表截图 #

修正后的代码 #

Option Explicit

Sub formatData()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastCol As Integer
    Dim lastRow As Integer
    Dim targetRow As Long
    Dim col As Integer
    Dim dataRange As Range
    Dim dateVal As Variant
    
    ' 定义工作表对象，避免频繁Select操作
    Set wsSource = ThisWorkbook.Sheets("FCST")
    Set wsTarget = ThisWorkbook.Sheets("reFormFCST")
    
    ' 获取源数据的最后一列（从F5向右）和最后一行（从B5向下）
    lastCol = wsSource.Range("F5").End(xlToRight).Column
    lastRow = wsSource.Range("B5").End(xlDown).Row
    
    ' 初始化目标工作表的起始行（从B2开始）
    targetRow = 2
    
    ' 遍历每一列（从F列即第6列开始到最后一列）
    For col = 6 To lastCol
        ' 获取当前列的数据范围（从第5行到最后一行）
        Set dataRange = wsSource.Range(wsSource.Cells(5, col), wsSource.Cells(lastRow, col))
        
        ' 将数据粘贴到目标工作表的B列
        dataRange.Copy wsTarget.Cells(targetRow, 2)
        
        ' 获取当前列对应的日期（假设日期在当前列的第4行，可根据实际调整）
        dateVal = wsSource.Cells(4, col).Value
        
        ' 将日期填充到C列，行数与数据行一致
        wsTarget.Range(wsTarget.Cells(targetRow, 3), wsTarget.Cells(targetRow + dataRange.Rows.Count - 1, 3)).Value = dateVal
        
        ' 更新目标行，为下一列数据预留位置
        targetRow = targetRow + dataRange.Rows.Count
    Next col
    
    ' 清除剪贴板，释放内存
    Application.CutCopyMode = False
End Sub

代码说明 #

1. 使用工作表对象直接引用，彻底避免Select操作，提升代码稳定性和运行效率
2. 动态计算目标粘贴行，确保每列数据依次追加，不会被覆盖
3. 一次性批量填充对应日期，无需逐行循环，大幅提升处理速度
4. 日期行号可根据实际需求调整：若源数据日期不在第4行，修改wsSource.Cells(4, col)中的行号即可

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