Excel重启后Data Validation失效报错，寻求VBA代码优化建议

我通过VBA创建了Data Validation，文件打开时代码运行完全正常，但关闭并重新打开Excel文件后，弹出如截图所示的错误。

原代码 #

Sub SetupDataValidation()

    Dim wsContactSheet As Worksheet
    Dim ContactTable As ListObject
    Dim lastrowContactTable As Long
    Dim validationRange As Range
    Dim validationFormula As String
    Dim i As Long
    Dim supportToAdd As Worksheet
    Dim inputTrainer As String

    On Error GoTo ErrorHandler

    ' Set worksheet and table references
    Set wsContactSheet = ThisWorkbook.Sheets("ContactSheet")
    Set ContactTable = wsContactSheet.ListObjects("AM")
    Set supportToAdd = ThisWorkbook.Sheets("SupportToAdd")
    
    ' Get trainer name to compare with the names in column F of table AM
    inputTrainer = supportToAdd.Range("A1").Value

  
    ' Construct the validation formula
    For i = 2 To ContactTable.ListRows.Count
        If Not IsEmpty(wsContactSheet.Cells(i, 6).Value) And wsContactSheet.Cells(i, 6).Value = inputTrainer Then
            validationFormula = validationFormula & "," & wsContactSheet.Cells(i, 1).Value
        End If
    Next i


    ' Apply data validation to the specified range
    On Error Resume Next ' Turn on error handling
    Set validationRange = supportToAdd.Range("D3")
    If Not validationRange Is Nothing Then
        With validationRange.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=validationFormula
            .IgnoreBlank = True
            .InCellDropdown = True
        End With
    Else
        MsgBox "Range D3 not found in the worksheet", vbExclamation
    End If
    On Error GoTo 0 ' Reset error handling

    
    ' Assign D3 value with the first value in the data validation list
   If Not IsEmpty(supportToAdd.Range("D3").Validation.Formula1) Then
        Dim firstValue As String
        firstValue = Split(Mid(validationFormula, 2), ",")(0)
        supportToAdd.Range("D3").Value = firstValue
    End If
    Exit Sub
    
ErrorHandler:
        MsgBox "An error occurred: " & Err.Description, vbCritical
        
    End Sub

技术优化建议 #

• 改用动态范围作为验证来源，避免硬编码字符串
  当前直接拼接逗号分隔的字符串作为验证公式，Excel数据验证的Formula1存在255字符长度限制，且文件重新打开时可能因格式解析问题失效。建议将匹配结果存入辅助列（可隐藏），用该列范围作为验证来源：

  ' 示例：将匹配值写入辅助列
  Dim outputCol As Range
  Set outputCol = supportToAdd.Range("Z:Z") ' 选择隐藏列存储
  outputCol.ClearContents
  
  Dim rowNum As Long
  rowNum = 1
  For i = 1 To ContactTable.ListRows.Count
      Dim trainerVal As Variant
      trainerVal = ContactTable.ListColumns(6).DataBodyRange(i).Value
      If Not IsEmpty(trainerVal) And trainerVal = inputTrainer Then
          outputCol(rowNum).Value = ContactTable.ListColumns(1).DataBodyRange(i).Value
          rowNum = rowNum + 1
      End If
  Next i
  
  ' 应用数据验证
  With validationRange.Validation
      .Delete
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
           Formula1:="=" & outputCol.Resize(rowNum - 1).Address(False, False, xlA1, True)
      .IgnoreBlank = True
      .InCellDropdown = True
  End With
  

• 使用ListObject原生属性访问表格数据
  原代码用wsContactSheet.Cells(i, 6)定位表格列，若表格位置变动（如插入列）会出错。直接通过ListColumns访问更稳定：

  ' 替换原遍历逻辑
  For i = 1 To ContactTable.ListRows.Count
      Dim cellVal As Variant
      ' 替换为表格F列的实际表头名称，比如"Trainer"
      cellVal = ContactTable.ListColumns("Trainer").DataBodyRange(i).Value
      If Not IsEmpty(cellVal) And cellVal = inputTrainer Then
          validationFormula = validationFormula & "," & ContactTable.ListColumns("ID").DataBodyRange(i).Value
      End If
  Next i
  

• 移除冗余错误处理，精准管控异常
  原代码中On Error Resume Next用于获取validationRange，但只要工作表存在，supportToAdd.Range("D3")不会出错，该错误处理会掩盖其他问题，建议直接移除，统一由顶部的ErrorHandler处理。

• 处理空验证列表的边界情况
  当没有匹配的Trainer数据时，validationFormula为空，会导致数据验证设置失败及后续Split操作报错，需提前判断：

  ' 拼接完成后判断
  If Len(validationFormula) = 0 Then
      MsgBox "未找到匹配的Trainer数据", vbExclamation
      Exit Sub
  End If
  validationFormula = Mid(validationFormula, 2) ' 移除开头多余的逗号
  

• 设置文件打开时自动重建验证
  硬编码的验证列表在文件重启后易失效，将SetupDataValidation加入Workbook_Open事件，每次打开文件时重新生成验证：
  在ThisWorkbook模块中添加：

  Private Sub Workbook_Open()
      SetupDataValidation
  End Sub
  

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