Excel VBA中存储数据录入错误的动态数组实现方案咨询

问题说明 #

开发Excel数据校验VBA代码，已实现错误单元格着色：数据类型错误标红，范围错误标橙。原用MsgBox逐个提示错误，条目过多时操作繁琐，计划将所有错误信息存入动态数组，最后一次性展示所有错误，询问该方案可行性及实现方法。

现有代码：

Sub CheckColumns()
Dim rng As Range
Dim lCol As Long, lRow As Long
Dim DblLengthMin As Double
'Dim dynamicArray() As String
'Dim f As Integer
DblLengthMax = 20000
DblLengthMin = 5

lCol = Range("C2").End(xlToRight).Column
lRow = Range("C2").End(xlDown).Row

For Each rng In Range("C2", Cells(lRow, lCol))
    If IsNumeric(rng) = False Then
      rng.Interior.ColorIndex = 3
     'Array Entry: "A number has to be entered " & "Row " & rng.Row & " Column " & rng.Column
    End If

   If IsNumeric(rng) And rng.Value > DblLengthMax Or rng.Value < DblLengthMin Then
     rng.Interior.ColorIndex = 46
     'ArrayEntry "Value in " & "Row " & rng.Row & " Column " & rng.Column & " is out of range. Check for unit (mm)"
    
  End If

Next rng

' Print out an extra window that shows the number of mistakes made and a list of them and their place in their worksheet   

End Sub

解决方案 #

该方案完全可行，以下是实现步骤和修改后的代码：

核心改动要点 #

• 启用并使用动态数组存储错误信息
• 遍历单元格时，将错误信息添加到数组中
• 遍历结束后，将数组内容合并为字符串，一次性展示

修改后的完整代码 #

Sub CheckColumns()
    Dim rng As Range
    Dim lCol As Long, lRow As Long
    Dim DblLengthMin As Double, DblLengthMax As Double
    Dim dynamicArray() As String
    Dim errorCount As Integer ' 记录错误数量，用于数组扩容
    
    DblLengthMax = 20000
    DblLengthMin = 5
    errorCount = 0 ' 初始化错误计数器
    
    lCol = Range("C2").End(xlToRight).Column
    lRow = Range("C2").End(xlDown).Row
    
    For Each rng In Range("C2", Cells(lRow, lCol))
        ' 数据类型错误处理
        If Not IsNumeric(rng) Then
            rng.Interior.ColorIndex = 3
            errorCount = errorCount + 1
            ' 动态扩容数组（Preserve保留已有数据）
            ReDim Preserve dynamicArray(1 To errorCount)
            ' 添加错误信息到数组
            dynamicArray(errorCount) = "数据类型错误：第" & rng.Row & "行，第" & rng.Column & "列需输入数字"
        End If
        
        ' 范围错误处理（先判断是数字再检查范围，避免非数字触发）
        If IsNumeric(rng) Then
            If rng.Value > DblLengthMax Or rng.Value < DblLengthMin Then
                rng.Interior.ColorIndex = 46
                errorCount = errorCount + 1
                ReDim Preserve dynamicArray(1 To errorCount)
                dynamicArray(errorCount) = "范围错误：第" & rng.Row & "行，第" & rng.Column & "列数值超出范围（5-20000），请检查单位(mm)"
            End If
        End If
    Next rng
    
    ' 一次性展示所有错误信息
    If errorCount > 0 Then
        ' 用换行符连接数组内容，生成错误列表
        Dim errorMsg As String
        errorMsg = "共发现" & errorCount & "处错误：" & vbCrLf & vbCrLf & Join(dynamicArray, vbCrLf)
        MsgBox errorMsg, vbExclamation, "数据校验结果"
    Else
        MsgBox "数据校验通过，未发现错误！", vbInformation, "数据校验结果"
    End If
End Sub

关键代码解释 #

1. 动态数组处理：
   • 声明dynamicArray() As String作为动态数组
   • 用errorCount记录错误数量，每次新增错误时用ReDim Preserve扩容数组，Preserve关键字用于保留数组中已有的数据
2. 错误信息添加：
   • 每种错误类型对应一条格式化的错误信息，明确标注错误位置和原因
3. 批量展示：
   • 使用Join函数将数组元素用换行符vbCrLf连接成连贯的字符串
   • 最后通过一个MsgBox集中展示所有错误，无错误时提示校验通过

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