如何通过VBA/宏迁移Excel调度表数据至新表重排版以导出至Access

最稳妥的实现方式是用VBA宏生成独立的新工作表，全程仅读取原表数据，不会改动原表的任何内容与格式，生成的表是标准二维结构，可直接导入Access，自动处理日期去冗余、单日多任务拆分的需求。

操作步骤 #

• 打开你的调度工作簿，按Alt+F11呼出VBA编辑器
• 在左侧工程资源管理器中右键点击当前工作簿名称，选择「插入」-「模块」
• 将下方代码粘贴到弹出的模块代码窗口中，根据你自己原表的实际位置修改代码开头的配置参数（注释已标注每个参数的含义）
• 按F5运行宏，即可自动生成名为导Access专用的标准化工作表。

VBA代码 #

注意：你只需要修改代码开头「参数修改区」的配置即可，后续执行逻辑无需调整

Sub 生成导Access用调度表()
    ' ========== 以下参数请根据你的原表实际情况修改 ==========
    Const 原表名称 As String = "Sheet1"       ' 你原来的调度表工作表名
    Const 日期所在列 As String = "A"          ' 原表中日期字段所在的列号
    Const 任务起始行 As Long = 3              ' 原表中第一条调度记录所在的行号
    Const 任务内容列 As String = "C"          ' 原表中任务内容所在列
    Const 负责人列 As String = "D"            ' 原表中负责人所在列
    Const 备注列 As String = "E"              ' 原表中备注/其他字段所在列，没有就留空
    Const 新表名称 As String = "导Access专用" ' 生成的新工作表名称
    ' ========== 参数修改区结束 ==========

    Dim wsOld As Worksheet, wsNew As Worksheet
    Dim lastRow As Long, newRow As Long, i As Long
    Dim currentDate As Variant
    
    ' 关闭屏幕更新提升运行速度
    Application.ScreenUpdating = False
    
    ' 绑定原表
    Set wsOld = ThisWorkbook.Worksheets(原表名称)
    ' 删除已存在的同名新表避免报错
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets(新表名称).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    ' 创建新表写表头
    Set wsNew = ThisWorkbook.Worksheets.Add(after:=wsOld)
    wsNew.Name = 新表名称
    wsNew.Range("A1:F1") = Array("调度日期", "任务内容", "负责人", "备注", "开始时间", "结束时间")
    newRow = 2 ' 新表从第二行开始写数据
    
    ' 找到原表最后一行有内容的行
    lastRow = wsOld.Cells(wsOld.Rows.Count, 任务内容列).End(xlUp).Row
    
    ' 遍历原表逐行读数据
    For i = 任务起始行 To lastRow
        ' 处理日期：当前行日期单元格有值就更新当前日期，没值就沿用上一个有效日期
        If wsOld.Range(日期所在列 & i).Value <> "" Then
            currentDate = wsOld.Range(日期所在列 & i).Value
        End If
        
        ' 跳过任务内容为空的空行
        If wsOld.Range(任务内容列 & i).Value <> "" And Not IsEmpty(currentDate) Then
            ' 往新表写一行数据，日期直接用存好的currentDate，不会冗余
            wsNew.Cells(newRow, "A").Value = currentDate
            wsNew.Cells(newRow, "A").NumberFormat = "yyyy-mm-dd" ' 统一日期格式，避免Access识别错误
            wsNew.Cells(newRow, "B").Value = wsOld.Range(任务内容列 & i).Value
            wsNew.Cells(newRow, "C").Value = wsOld.Range(负责人列 & i).Value
            If 备注列 <> "" Then
                wsNew.Cells(newRow, "D").Value = wsOld.Range(备注列 & i).Value
            End If
            ' 如果你的原表有开始、结束时间字段，把下面两行的列号改成对应列即可
            ' wsNew.Cells(newRow, "E").Value = wsOld.Range("F" & i).Value
            ' wsNew.Cells(newRow, "F").Value = wsOld.Range("G" & i).Value
            
            newRow = newRow + 1
        End If
    Next i
    
    ' 自动调整新表列宽
    wsNew.Columns.AutoFit
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    MsgBox "导表完成，共生成" & newRow - 2 & "条任务记录", vbInformation
End Sub

注意事项 #

• 代码仅对原表做只读操作，不会修改原表的单元格内容、格式、合并单元格设置，完全符合不改动原表的要求
• 自动适配单日单任务/多任务场景：日期列如果是合并单元格、或者仅在当日第一行填了日期、后续行留空的格式，代码会自动沿用最近一次读到的有效日期，生成的新表中每条任务对应一行，日期字段准确无冗余
• 日期字段输出为标准日期格式，不会转成文本，导入Access时可直接被识别为日期类型，不会出现格式错乱
• 如果原表还有其他需要导入的字段（比如任务优先级、地点等），直接在代码写表头的位置加字段名，在写数据的部分增加对应列的取值即可，逻辑和现有字段一致。

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