如何按日期（月份对应目标工作表、日期对应目标列）复制Excel单元格？

核心逻辑 #

• 读取目标日期，提取其中的日部分
• 根据日数匹配目标工作表的对应列（比如示例中19日对应U列）
• 复制DCL127工作表中整理好的数据到目标列

VBA 代码示例 #

Sub CopyDataByDate()
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim targetDate As Date
    Dim dayNum As Integer
    Dim targetCol As Integer
    Dim sourceRange As Range
    Dim targetRange As Range
    
    ' 绑定工作表对象
    Set sourceWs = ThisWorkbook.Worksheets("DCL127")
    Set targetWs = ThisWorkbook.Worksheets("Sheet 1")
    
    ' --- 按需修改：日期读取位置 ---
    ' 示例：日期存在DCL127的A1单元格，格式为dd.mm.yyyy
    targetDate = DateValue(Replace(sourceWs.Range("A1").Value, ".", "/"))
    dayNum = Day(targetDate)
    
    ' --- 按需修改：列对应规则 ---
    ' 示例：1日对应C列（第3列），19日对应U列（第21列），偏移量为2
    targetCol = dayNum + 2 ' 若1日对应A列，直接写 targetCol = dayNum 即可
    
    ' 定位源数据范围（示例：DCL127的B列，从第2行到最后一行有数据的单元格）
    Set sourceRange = sourceWs.Range("B2:B" & sourceWs.Cells(sourceWs.Rows.Count, "B").End(xlUp).Row)
    
    ' 定位目标范围：对应列的第2行开始，匹配源数据行数
    Set targetRange = targetWs.Cells(2, targetCol).Resize(sourceRange.Rows.Count, 1)
    
    ' 复制数据（带格式用Copy，仅复制值用Value赋值）
    sourceRange.Copy targetRange
    ' 仅复制值可替换为：targetRange.Value = sourceRange.Value
    
    ' 释放对象
    Set sourceWs = Nothing
    Set targetWs = Nothing
    Set sourceRange = Nothing
    Set targetRange = Nothing
    
    MsgBox "数据复制完成！", vbInformation
End Sub

代码调整说明 #

• 日期位置：如果日期不在DCL127的A1，修改sourceWs.Range("A1").Value为实际单元格地址
• 列对应规则：根据你的工作表列起始位置调整偏移量，比如1日对应E列（第5列），则targetCol = dayNum + 4
• 源数据列：如果整理后的数据在DCL127的C列，把"B2:B..."改成"C2:C..."
• 复制方式：不需要格式时，用targetRange.Value = sourceRange.Value更高效

使用步骤 #

1. 打开Excel文件，按Alt + F11打开VBA编辑器
2. 右键点击工作簿 → 插入 → 模块
3. 粘贴代码并修改配置项
4. 按F5运行宏，或在Excel开发工具中找到宏执行

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