优化VBA代码：基于指定单元格结果跨工作表复制数据集

原代码运行慢的核心问题是复制了整列（1048576行），哪怕大部分行是空的也会全量复制，同时重复逻辑过多。下面是优化后的代码，既简化结构又大幅提升速度：

Sub RefreshDataSet()
    ' 关闭Excel后台操作，提升运行速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Dim wsData As Worksheet, wsExport As Worksheet, wsResults As Worksheet
    Dim targetName As String
    Dim datasetMap As Object
    Dim sourceRange As Range, destRange As Range
    
    ' 提前定义工作表对象，避免重复调用
    Set wsData = ThisWorkbook.Worksheets("Data_files")
    Set wsExport = ThisWorkbook.Worksheets("Data_Export")
    Set wsResults = ThisWorkbook.Worksheets("Results")
    Set datasetMap = CreateObject("Scripting.Dictionary")
    
    ' 用字典映射数据集名称和对应的列范围
    datasetMap("EUR CLO1") = "A:AK"
    datasetMap("EUR CLO2") = "AL:CA"
    datasetMap("EUR CLO3") = "CB:DP"
    datasetMap("EUR CLO4") = "DQ:FG"
    datasetMap("EUR CLO5") = "FH:HB"
    
    ' 获取目标数据集名称
    targetName = wsResults.Range("D3").Value
    
    ' 清理导出表的已有数据
    wsExport.UsedRange.Clear
    
    ' 匹配到对应数据集则执行复制
    If datasetMap.Exists(targetName) Then
        ' 只取对应列范围内的有效数据区域，避免复制空行
        Set sourceRange = wsData.Range(datasetMap(targetName)).Resize(wsData.UsedRange.Rows.Count)
        ' 定位导出区域，匹配源数据的行列数
        Set destRange = wsExport.Range("A1").Resize(sourceRange.Rows.Count, sourceRange.Columns.Count)
        ' 复制数据值
        destRange.Value = sourceRange.Value
    End If
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

优化说明 #

• 只复制有效数据：不再复制整列，而是基于Data_files的已使用行数截取对应列的有效区域，大幅减少数据传输量
• 字典映射简化逻辑：用字典把数据集名称和列范围绑定，替代冗长的ElseIf判断，后续新增数据集只需在字典里加一行即可
• 关闭后台操作：暂时关闭屏幕刷新、事件触发和自动计算，避免Excel在运行过程中做额外工作
• 变量更规范：避免使用VBA关键字name作为变量名，同时提前定义工作表对象，减少重复调用的开销
• 精准清理：只清理导出表的已使用区域，比清空整个工作表更高效

内容的提问来源于stack exchange，提问作者Michal Smętek