通过VBA加载数据验证后Excel工作簿出现报错问题

核心问题 #

你的代码存在两个关键问题，导致数据验证损坏及批量丢失：

1. 字符长度超限：Excel数据验证的Formula1参数最大仅支持255个字符，当文件夹内文件较多或文件名较长时，Join(GetWindowsFiles(...), ",")生成的字符串会突破这个限制，导致验证规则无法正常保存。重新打开工作簿时，Excel会因规则损坏自动清除所有数据验证（包括手动创建的）。
2. 重复重建验证：每次选中C10单元格都会执行.Delete和.Add操作，反复删除重建会大幅增加验证规则损坏的概率，同时也会造成不必要的性能消耗。

修复方案 #

方案1：改用单元格区域引用替代直接拼接字符串

创建一个隐藏工作表存储文件名列表，让数据验证引用这个区域，彻底避开字符长度限制：

Private Sub Worksheet_Activate()
    ' 工作表激活时更新数据验证，避免每次选中单元格都触发
    Dim ws As Worksheet
    Dim listWs As Worksheet
    Dim myCell As Range
    Dim sTemplatePath As String
    Dim fileNames As Variant
    
    Set ws = ThisWorkbook.Worksheets(1)
    Set myCell = ws.Range("C10")
    sTemplatePath = "[你的有效Windows文件路径]"
    
    ' 检查是否存在存储列表的隐藏工作表，不存在则创建
    On Error Resume Next
    Set listWs = ThisWorkbook.Worksheets("FileList")
    On Error GoTo 0
    If listWs Is Nothing Then
        Set listWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        listWs.Name = "FileList"
        listWs.Visible = xlSheetHidden ' 隐藏工作表
    End If
    
    ' 清空旧数据并写入新文件名
    listWs.Cells.Clear
    fileNames = GetWindowsFiles(sTemplatePath)
    If Not IsEmpty(fileNames) Then
        listWs.Range("A1").Resize(UBound(fileNames), 1).Value = Application.Transpose(fileNames)
    End If
    
    ' 设置数据验证，引用隐藏工作表的区域
    With myCell.Validation
        .Delete
        If Not IsEmpty(fileNames) Then
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=FileList!$A$1:$A$" & UBound(fileNames)
        End If
    End With
End Sub

Function GetWindowsFiles(ByVal sPath As String) As Variant
    On Error GoTo codeErr
    Dim vaArray As Variant
    Dim i As Integer
    Dim oFile As Object
    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFiles As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    Set oFiles = oFolder.Files

    If oFiles.Count = 0 Then
        GetWindowsFiles = Empty
        Exit Function
    End If

    ReDim vaArray(1 To oFiles.Count)
    i = 1
    For Each oFile In oFiles
        vaArray(i) = oFile.Name
        i = i + 1
    Next

    GetWindowsFiles = vaArray

codeExit:
    Exit Function
codeErr:
    Debug.Print Err.Number & " " & Err.Description
    GetWindowsFiles = Empty
    Resume codeExit
End Function

方案2：优化触发时机（可选）

将触发事件从Worksheet_SelectionChange改为Worksheet_Activate，或者添加一个手动刷新按钮，避免每次选中单元格都执行验证重建操作，减少无效触发。

额外注意事项

• 确保隐藏的FileList工作表不会被意外删除，否则数据验证会失效
• 如果文件夹内文件更新频繁，建议使用手动刷新按钮触发更新，避免自动触发带来的性能损耗

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